compiler errors now show a popover

src/Spec2-Adapters-Morphic/SpAbstractMorphicAdapter.class.st

@@ -553,7 +553,7 @@ SpAbstractMorphicAdapter >> styleSheet [
 { #category : #protocol }
 SpAbstractMorphicAdapter >> takeKeyboardFocus [
 
-	self widget ifNotNil: [ :w | w takeKeyboardFocus ]
+	self widgetDo: [ :w | w takeKeyboardFocus ]
 ]
 
 { #category : #'drag and drop' }

src/Spec2-Adapters-Morphic/SpMorphicBaseTextAdapter.class.st

@@ -127,8 +127,8 @@ SpMorphicBaseTextAdapter >> insert: aString at: positionIndex [
 { #category : #'spec protocol' }
 SpMorphicBaseTextAdapter >> notify: errorMessage at: position in: sourceCode [
 
-	self flag: #TOMOVE.
-	self widgetDo: [ :w | w notify: errorMessage at: position in: sourceCode ]
+	self widgetDo: [ :w | 
+		w notify: errorMessage at: position in: sourceCode ]
 ]
 
 { #category : #'spec protocol' }
@@ -197,6 +197,15 @@ SpMorphicBaseTextAdapter >> selectionInterval [
 	^ self widget selectionInterval 
 ]
 
+{ #category : #private }
+SpMorphicBaseTextAdapter >> selectionInterval: anInterval [
+
+	self widgetDo: [ :w | 
+		w textArea editor 
+			selectFrom: anInterval first 
+			to: anInterval last ]
+]
+
 { #category : #private }
 SpMorphicBaseTextAdapter >> setEditingModeFor: textArea [
 

src/Spec2-Adapters-Morphic/SpMorphicTextAdapter.class.st

@@ -49,9 +49,14 @@ SpMorphicTextAdapter >> buildWidget [
 	self setEditingModeFor: newWidget.
 	self setText: self presenter text to: newWidget.
 
-	self presenter whenTextChangedDo: [ :text | self setText: text to: newWidget ].
-	self presenter whenPlaceholderChangedDo: [ :text | self setGhostText: text to: newWidget ].
-	self presenter whenEditableChangedDo: [ :value | self setEditable: value to: newWidget ].
+	self presenter whenTextChangedDo: [ :text | 
+		self setText: text to: newWidget ].
+	self presenter whenSelectionChangedDo: [ :selectionInterval | 
+		self selectionInterval: selectionInterval ].
+	self presenter whenPlaceholderChangedDo: [ :text | 
+		self setGhostText: text to: newWidget ].
+	self presenter whenEditableChangedDo: [ :value | 
+		self setEditable: value to: newWidget ].
 
 	^ newWidget
 ]

src/Spec2-Adapters-Morphic/SpMorphicTextInputFieldAdapter.class.st

@@ -40,12 +40,17 @@ SpMorphicTextInputFieldAdapter >> buildWidget [
 		maxLength: self presenter maxLength;
 		yourself.
 
-	self presenter whenTextChangedDo: [ :text | newWidget setText: text ].
+	self presenter whenTextChangedDo: [ :text | 
+		newWidget setText: text ].
+	self presenter whenSelectionChangedDo: [ :selectionInterval | 
+		self selectionInterval: selectionInterval ].
 	self presenter whenPlaceholderChangedDo: [ :text | 
 		newWidget ghostText: (text ifNotNil: [ :aString | 
 			aString localizedForPresenter: self presenter ]) ].
-	self presenter whenPasswordChangedDo: [ :isPassword | newWidget encrypted: isPassword ].
-	self presenter whenMaxLengthChangedDo: [ :length | newWidget maxLength: length ].
+	self presenter whenPasswordChangedDo: [ :isPassword | 
+		newWidget encrypted: isPassword ].
+	self presenter whenMaxLengthChangedDo: [ :length | 
+		newWidget maxLength: length ].
 
 	^ newWidget
 ]

src/Spec2-Adapters-Morphic/SpStyle.class.st

@@ -40,7 +40,24 @@ Class {
 { #category : #private }
 SpStyle class >> createDefaultStyleSheet [
 
-	^ SpStyleSTONReader fromString: '
+	^ SpStyleSTONReader fromString: self defaultStyleSheetData
+
+]
+
+{ #category : #accessing }
+SpStyle class >> defaultStyleSheet [
+
+	self flag: #TODO. "This is wrong. Default style sheet should reside in the Pharo application, 
+	but since we do not have that abstraction (yet) in the system, we put it here for now"
+	^ DefaultStyleSheet ifNil: [ 
+		DefaultStyleSheet := self createDefaultStyleSheet ].
+
+]
+
+{ #category : #private }
+SpStyle class >> defaultStyleSheetData [
+
+	^'
 .application [
 	Font { #name: "Source Sans Pro", #size: 10 },
 	Geometry { #height: 25 },
@@ -70,7 +87,9 @@ SpStyle class >> createDefaultStyleSheet [
 		]
 	],
 	.checkBox [  
-		Geometry { #hResizing: true }
+		Geometry { #hResizing: true },
+		.compact [
+			Geometry { #hResizing: false, #width: 20 } ]
 	],
 	.radioButton [ 
 		Geometry { #hResizing: true }
@@ -85,10 +104,7 @@ SpStyle class >> createDefaultStyleSheet [
 		Geometry { #width: 150, #hResizing: true }
 	],
 	.actionBar [  
-		Container { 
-			#borderColor: Color { #rgb: 0, #alpha: 0 }, 
-			#borderWidth: 2, 
-			#padding: 5 },
+		Container { #borderWidth: 0, #padding: 5 },
 		Geometry { #width: 150, #height: 29, #hResizing: true, #vResizing: false }
 	],
 	.menuBar [
@@ -119,21 +135,15 @@ SpStyle class >> createDefaultStyleSheet [
 			Geometry { #width : 25 }
 		]
 	],
+	.codePopoverError [ 
+		Draw { #backgroundColor: #C20000 },
+		Font { #color: #white } 
+	],
 	.scrollbarPopoverLarge [ 
 		Geometry { #height: 350 } 
 	]
 ]
-'
-]
-
-{ #category : #accessing }
-SpStyle class >> defaultStyleSheet [
-
-	self flag: #TODO. "This is wrong. Default style sheet should reside in the Pharo application, 
-	but since we do not have that abstraction (yet) in the system, we put it here for now"
-	^ DefaultStyleSheet ifNil: [ 
-		DefaultStyleSheet := self createDefaultStyleSheet ].
-
+'	
 ]
 
 { #category : #'instance creation' }

src/Spec2-Adapters-Morphic/SpStyleDraw.class.st

@@ -79,14 +79,3 @@ SpStyleDraw >> color: aColorOrSymbol [
 
 	color := self toColor: aColorOrSymbol
 ]
-
-{ #category : #private }
-SpStyleDraw >> toColor: aColorOrSymbol [
-
-	"Try if color"
-	aColorOrSymbol isSymbol ifFalse: [ ^ aColorOrSymbol ].
-	"Try by name"
-	(Color named: aColorOrSymbol) ifNotNil: [ :aColor | ^ aColor ]. 
-	"Try by HEX (CSS style)"				
-	^ Color fromHexString: aColorOrSymbol
-]

src/Spec2-Adapters-Morphic/SpStyleFont.class.st

@@ -28,7 +28,8 @@ Class {
 		'name',
 		'size',
 		'italic',
-		'bold'
+		'bold',
+		'color'
 	],
 	#classVars : [
 		'FontCache'
@@ -63,11 +64,16 @@ SpStyleFont >> addFontToCache: aFont [
 { #category : #operations }
 SpStyleFont >> applyTo: aMorph [
 
-	"not all morphs understand font, I neet to verify it (which is not cool verifying a 
+	"not all morphs understand font, I need to verify it (which is not cool verifying a 
 	 selector but other way would be to define #font: in Morph and I do not want that)"
 	(aMorph respondsTo: #font:) ifFalse: [ ^ self ].
 
-	aMorph font: self definedFont
+	aMorph font: self definedFont.
+
+	self color ifNil: [ ^ self ].
+	"Again, not all morphs understand #textColor: and I need to verify it is there."
+	(aMorph respondsTo: #textColor:) ifFalse: [ ^ self ].
+	aMorph textColor: self color
 ]
 
 { #category : #accessing }
@@ -94,6 +100,23 @@ SpStyleFont >> calculateDefinedFont [
 	^ font
 ]
 
+{ #category : #accessing }
+SpStyleFont >> color [
+  "This is meant to set the text color.
+	This property can be expressed as 
+	- a STON map: ==Color { #red : 1., #green : 0, #blue : 0, #alpha : 1 }==
+	- a named selector: ==#red==
+	- an hex string: =='FF0000'=="
+
+	^ color
+]
+
+{ #category : #accessing }
+SpStyleFont >> color: aColorOrSymbol [
+
+	color := self toColor: aColorOrSymbol
+]
+
 { #category : #private }
 SpStyleFont >> definedFont [
 	| definedFont |

src/Spec2-Adapters-Morphic/SpStyleProperty.class.st

@@ -57,3 +57,14 @@ SpStyleProperty >> mergeWith: otherProperty [
 
 	^ merged
 ]
+
+{ #category : #private }
+SpStyleProperty >> toColor: aColorOrSymbol [
+
+	"Try if color"
+	aColorOrSymbol isSymbol ifFalse: [ ^ aColorOrSymbol ].
+	"Try by name"
+	(Color named: aColorOrSymbol) ifNotNil: [ :aColor | ^ aColor ]. 
+	"Try by HEX (CSS style)"				
+	^ Color fromHexString: aColorOrSymbol
+]

src/Spec2-Adapters-Morphic/SpTMorphicTableDataSourceCommons.trait.st

@@ -23,6 +23,9 @@ SpTMorphicTableDataSourceCommons >> headerColumn: column [
 			withValue: column).
 	column sortingIcon ifNotNil: [ :icon | headerMorph addMorph: icon ] ].
 
+	"column isExpandable ifFalse: [ 
+		headerMorph hResizing: #shrinkWrap ]."
+
 	^ headerMorph
 ]
 

src/Spec2-Code-Morphic/SpMorphicCodeAdapter.class.st

@@ -37,7 +37,7 @@ SpMorphicCodeAdapter >> buildWidget [
 		newWidget withLineNumbers ].
 	self presenter interactionModel ifNotNil: [ :im | 
 		self setInteractionModel: im to: newWidget ].
-	
+ 
 	self presenter whenLineNumbersChangedDo: [ :hasLineNumbers | 
 		self changeLineNumbers: hasLineNumbers to: newWidget ].
 	self presenter whenSyntaxHighlightChangedDo: [ :hasSyntaxHighlight | 

src/Spec2-Code/SpCodeInteractionModel.class.st

@@ -60,12 +60,43 @@ SpCodeInteractionModel >> hasBindingThatBeginsWith: aString [
 		anySatisfy: [ :each | each beginsWith: aString ]
 ]
 
+{ #category : #'interactive error protocol' }
+SpCodeInteractionModel >> interactive [
+
+	^ true
+]
+
 { #category : #testing }
 SpCodeInteractionModel >> isForScripting [
 
 	^ false
 ]
 
+{ #category : #'interactive error protocol' }
+SpCodeInteractionModel >> notify: message at: location in: code [
+	| currentSelection stripMessage |
+
+	"self owner withAdapterDo: [ :anAdapter | 
+		anAdapter notify: message at: location in: code ]"
+
+	stripMessage := (message endsWith: '->')
+		ifTrue: [ message allButLast: 3 ]
+		ifFalse: [ message ].
+
+	currentSelection := self owner selectionInterval.
+	self owner 
+		insertPopover: (SpCodePopoverErrorPresenter 
+			newCode: self owner 
+			message: stripMessage) 
+		atIndex: (currentSelection isEmptyOrNil
+			ifTrue: [ location ]
+			ifFalse: [ 
+				"both selection and location are 1-based, but position will be zero-based 
+				 (zero=first element), to actually arrive to the position I want I need to 
+				 substract two elements"
+				currentSelection first + location - 2 ])
+]
+
 { #category : #accessing }
 SpCodeInteractionModel >> owner [
 

src/Spec2-Code/SpCodePopoverErrorPresenter.class.st

@@ -0,0 +1,98 @@
+"
+I show a compiler error as a popover (instead inserting an error string, which pollutes the text)
+"
+Class {
+	#name : #SpCodePopoverErrorPresenter,
+	#superclass : #SpPopoverContentPresenter,
+	#instVars : [
+		'object',
+		'code',
+		'text',
+		'message'
+	],
+	#category : #'Spec2-Code'
+}
+
+{ #category : #'instance creation' }
+SpCodePopoverErrorPresenter class >> newCode: aPresenter message: aString [
+
+	^ (self on: aString)
+		code: aPresenter;
+		yourself
+]
+
+{ #category : #accessing }
+SpCodePopoverErrorPresenter >> code [
+
+	^ code
+]
+
+{ #category : #accessing }
+SpCodePopoverErrorPresenter >> code: aPresenter [
+
+	code := aPresenter
+]
+
+{ #category : #'api-focus' }
+SpCodePopoverErrorPresenter >> defaultKeyboardFocus [
+
+	^ text
+]
+
+{ #category : #api }
+SpCodePopoverErrorPresenter >> dismiss [
+
+	super dismiss.
+	self code takeKeyboardFocus
+]
+
+{ #category : #initialization }
+SpCodePopoverErrorPresenter >> initializePresenters [
+
+	self initializeText.
+
+	layout := SpBoxLayout newHorizontal
+		add: text;
+		yourself.
+
+	text eventHandler whenFocusLostDo: [ self dismiss ].
+
+	self flag: #TODO. "This is uber bad. Keybindings needs to come from application configuration"
+	text
+		bindKeyCombination: 
+			Character escape asKeyCombination 
+			| Character backspace asKeyCombination 
+			| Character cr asKeyCombination
+			toAction: [ self dismiss ]
+]
+
+{ #category : #initialization }
+SpCodePopoverErrorPresenter >> initializeText [
+
+	text := self newText
+		propagateNaturalWidth: true;
+		propagateNaturalHeight: false;
+		editable: false;
+		text: self message;
+		"addStyle: 'codePopover';"
+		addStyle: 'codePopoverError';
+		yourself
+]
+
+{ #category : #accessing }
+SpCodePopoverErrorPresenter >> message [
+
+	^ message
+]
+
+{ #category : #accessing }
+SpCodePopoverErrorPresenter >> message: aString [
+
+	message := aString
+]
+
+{ #category : #'accessing model' }
+SpCodePopoverErrorPresenter >> setModelBeforeInitialization: aString [
+
+	message := aString
+]