Multiple changes:

- Add missing class extensions
- Add CarpDefinitionsElement and add it to module coder [fixes #9]
- Add tests stub to carp module

src/Carp/CarpDefinitionsElement.class.st

@@ -0,0 +1,97 @@
+Class {
+	#name : #CarpDefinitionsElement,
+	#superclass : #BrExpander,
+	#instVars : [
+		'module'
+	],
+	#category : #'Carp-Coder'
+}
+
+{ #category : #accessing }
+CarpDefinitionsElement >> addDefinitionEditorShortcutsTo: aPropertiesElement [
+
+	aPropertiesElement addShortcut: (BlShortcutWithAction new
+			 combination: BlKeyCombination arrowUp;
+			 action: [ :anEvent | 
+				 anEvent currentTarget deepestFocusedChild ifNotNil: [ 
+						 :aFocusedChild | 
+						 BlFocusFinder new
+							 up;
+							 root: anEvent currentTarget;
+							 referenceElement: aFocusedChild;
+							 nextFocusDo: [ :aNextFocusElement | 
+								 aNextFocusElement requestFocus ] ] ]).
+
+	aPropertiesElement addShortcut: (BlShortcutWithAction new
+			 combination: BlKeyCombination arrowDown;
+			 action: [ :anEvent | 
+				 anEvent currentTarget deepestFocusedChild ifNotNil: [ 
+						 :aFocusedChild | 
+						 BlFocusFinder new
+							 down;
+							 root: anEvent currentTarget;
+							 referenceElement: aFocusedChild;
+							 nextFocusDo: [ :aNextFocusElement | 
+								 aNextFocusElement requestFocus ] ] ])
+]
+
+{ #category : #accessing }
+CarpDefinitionsElement >> buildDefinitionEditor [
+
+	| theProperties |
+	theProperties := BrHorizontalGrid new constraintsDo: [ :c | 
+		                 c horizontal matchParent.
+		                 c vertical fitContent ].
+
+	self addDefinitionEditorShortcutsTo: theProperties.
+
+	theProperties addChild:
+		self module asGtMagritteViewModel asElement.
+
+	^ theProperties
+]
+
+{ #category : #accessing }
+CarpDefinitionsElement >> buildDefinitionReader [
+
+	| theProperties theReaders |
+	theProperties := BrHorizontalGrid new constraintsDo: [ :c | 
+		                 c horizontal matchParent.
+		                 c vertical fitContent ].
+
+	theProperties addChild:
+		(self module asGtMagritteViewModelWithDescription:
+			 self module usesDescription beReadOnly) asElement.
+
+	^ theProperties
+]
+
+{ #category : #accessing }
+CarpDefinitionsElement >> initialize [
+	super initialize.	
+
+	self
+		aptitude: GtCoderExpanderAptitude;
+		hMatchParent;
+		vFitContent
+]
+
+{ #category : #accessing }
+CarpDefinitionsElement >> module [
+	^ module
+]
+
+{ #category : #accessing }
+CarpDefinitionsElement >> module: aCarpModule [
+	module := aCarpModule.
+	self updateElements
+]
+
+{ #category : #accessing }
+CarpDefinitionsElement >> updateElements [
+
+	self header: [ 
+		self buildDefinitionReader ].
+	self content: [ 
+		self buildDefinitionEditor ]
+]

src/Carp/CarpModule.class.st

@@ -4,7 +4,8 @@ Class {
 	#instVars : [
 		'uses',
 		'expressions',
-		'name'
+		'name',
+		'tests'
 	],
 	#category : #'Carp-IDE'
 }
@@ -19,6 +20,11 @@ CarpModule >> addExpression: anExpression [
 	expressions add: anExpression
 ]
 
+{ #category : #accessing }
+CarpModule >> addTest: aTest [
+	tests add: aTest
+]
+
 { #category : #accessing }
 CarpModule >> addUse: aString [
 	uses add: aString
@@ -121,6 +127,7 @@ CarpModule >> expressions [
 CarpModule >> initialize [
 	uses := Set new.
 	expressions := OrderedCollection new.
+	tests := OrderedCollection new.
 ]
 
 { #category : #converting }
@@ -133,6 +140,16 @@ CarpModule >> name: aString [
 	name := aString
 ]
 
+{ #category : #accessing }
+CarpModule >> removeUse: aString [
+	uses remove: aString
+]
+
+{ #category : #accessing }
+CarpModule >> setUses: aCollectionOfStrings [
+	uses := aCollectionOfStrings asSet
+]
+
 { #category : #converting }
 CarpModule >> toCarp [
 
@@ -142,9 +159,86 @@ CarpModule >> toCarp [
 		  aStream << '(defmodule ' << self name << ' ' << (uses
 			   ifEmpty: [ '' ]
 			   ifNotEmpty: [ 
-			   Character lf , Character tab , '(use-all ' , (' ' join: uses)
+			   Character lf  asString , Character tab  asString, '(use-all ' , (' ' join: uses)
 			   , ')' ]).
 		  expressions do: [ :expression | 
 			  aStream << Character lf << Character tab << expression toCarp ].
 		  aStream << ')' ]
 ]
+
+{ #category : #accessing }
+CarpModule >> uses [
+	^ uses
+]
+
+{ #category : #accessing }
+CarpModule >> usesDescription [
+
+	<magritteDescription>
+	^ MAToManyRelationDescription new
+		  label: 'Uses';
+		  priority: 6;
+		  accessor: (MASelectorAccessor read: #uses write: #setUses:);
+		  classes: { String };
+		  blocListStencil: [ :aMemento :aDescription :aForm | 
+			  | aTagger |
+			  aTagger := BrTagger new.
+			  aTagger
+				  margin: ((BlInsets left: 7) withBottom: 4);
+				  hMatchParent;
+				  vFitContent.
+			  aForm hMatchParent.
+			  aDescription isReadOnly
+				  ifTrue: [ 
+					  aTagger aptitude: (BrGlamorousTaggerAptitude new
+							   margin: (BlInsets right: 5);
+							   tagLabel: [ :aTag | 
+								   | aLabel |
+								   aLabel := BrLabel new
+									             text: aTag name;
+									             padding: (BlInsets all: 4);
+									             geometry: (BlRoundedRectangleGeometry cornerRadius: 4);
+									             background:
+										             BrGlamorousColors neutralBackgroundColor;
+									             aptitude: (BrGlamorousLabelAptitude new
+											              glamorousCodeFont;
+											              fontSize: 10).
+
+								   aLabel ]) ]
+				  ifFalse: [ 
+					  aTagger aptitude: (BrGlamorousTaggerEditableAptitude new
+							   margin: (BlInsets right: 5);
+							   tagLabel: [ :aTag | 
+								   | aLabel |
+								   aLabel := BrEditableLabel new
+									             text: aTag name;
+									             aptitude: (BrGlamorousEditableLabelAptitude new
+											              glamorousCodeFont;
+											              defaultForeground: Color black;
+											              fontSize: 10).
+
+								   aLabel ]).
+					  aTagger when: BrTaggerAddTagRequest do: [ :aRequest | 
+						  aMemento
+							  write: ((aTagger tags collect: #name)
+									   add: aRequest tag name;
+									   yourself)
+							  using: aDescription ].
+					  aTagger when: BrTaggerRemoveTagRequest do: [ :aRequest | 
+						  aMemento
+							  write: ((aTagger tags collect: #name)
+									   remove: aRequest tag name;
+									   yourself)
+							  using: aDescription ] ].
+			  aTagger withAsyncSinkDo: [ :anElementSink | 
+				  anElementSink
+					  sink: AsyncPeakSink new;
+					  whenUpdate: [ :theTagger :aSink | 
+						  | theValues theTexts |
+						  theValues := aSink value currentValue.
+						  theTexts := theValues collect: [ :each | 
+								              aDescription displayStringFor: each ].
+						  theTagger namedTags: theTexts ].
+				  (aMemento readObservableValueUsing: aDescription) observe:
+					  anElementSink ] ]
+]

src/Carp/CarpModuleCoderElement.class.st

@@ -41,7 +41,7 @@ CarpModuleCoderElement >> buildContentTabs [
 
 { #category : #accessing }
 CarpModuleCoderElement >> buildDefinitionElement [
-	^ BrExpander new
+	^ CarpDefinitionsElement new module: self module
 ]
 
 { #category : #accessing }

src/Carp/GtSmaCCParserStyler.extension.st

@@ -0,0 +1,68 @@
+Extension { #name : #GtSmaCCParserStyler }
+
+{ #category : #'*Carp' }
+GtSmaCCParserStyler class >> carpStyler: aParserClass [
+
+	<smaccStyler: #CarpParser priority: 50>
+	^ (self forParser: aParserClass) stylerRules: { 
+			  (GtSmaCCKeywordTokensStylerRule styleBlock: [ :styler | 
+				   styler
+					   bold;
+					   foreground: Color purple ]).
+			  (GtSmaCCCommentStylerRule styleBlock: [ :styler | 
+				   styler foreground: Color lightGray ]).
+			  (GtSmaCCNodeStylerRule
+				   nodeClassName: #CarpNumberNode
+				   styleBlock: [ :styler | styler foreground: Color blue ]).
+			  (GtSmaCCNodeStylerRule
+				   nodeClassName: #CarpStringNode
+				   styleBlock: [ :styler | styler foreground: Color blue ]).
+			  (GtSmaCCNodeStylerRule
+				   nodeClassName: #CarpPatternNode
+				   styleBlock: [ :styler | styler foreground: Color blue ]).
+			  (GtSmaCCNodeStylerRule
+				   nodeClassName: #CarpListNode
+				   styleBlock: [ :styler :node :text | 
+					   (node expressions notEmpty and: [ 
+						    ((node expressions first isKindOf: CarpVariableNode) or:
+							     (node expressions first isKindOf: CarpModuleOrTypeNode)) 
+							    and: [ node isQuoted not ] ]) ifTrue: [ 
+						   (text
+							    from: node expressions first startPosition
+							    to: node expressions first stopPosition) foreground:
+							   Color purple ].
+					   CarpStylerUtilities
+						   colorAndHighlightParenthesesLeft: node startPosition
+						   right: node stopPosition
+						   atNestingLevel: node listDepth
+						   inText: text ]).
+			  (GtSmaCCNodeStylerRule
+				   nodeClassName: #CarpMapNode
+				   styleBlock: [ :styler :node :text | 
+					   CarpStylerUtilities
+						   colorAndHighlightParenthesesLeft: node startPosition
+						   right: node stopPosition
+						   atNestingLevel: node listDepth
+						   inText: text ]).
+			  (GtSmaCCNodeStylerRule
+				   nodeClassName: #CarpArrayNode
+				   styleBlock: [ :styler :node :text | 
+					   CarpStylerUtilities
+						   colorAndHighlightParenthesesLeft: node startPosition
+						   right: node stopPosition
+						   atNestingLevel: node listDepth
+						   inText: text ]).
+			  (GtSmaCCNodeStylerRule
+				   nodeClassName: #CarpVariableNode
+				   styleBlock: [ :styler | styler italic ]).
+			  (GtSmaCCNodeStylerRule
+				   nodeClassName: #CarpModuleOrTypeNode
+				   styleBlock: [ :styler :node :text | 
+					   (text
+						    from: node module startPosition
+						    to: node module stopPosition) foreground: Color orange ]).
+			  (GtSmaCCNodeVariableStylerRule
+				   nodeClassName: #SmaCCErrorNode
+				   variableNames: #( dismissedTokens errorToken )
+				   styleBlock: [ :styler | styler foreground: Color red ]) }
+]

src/Carp/LeLocalStore.extension.st

@@ -0,0 +1,9 @@
+Extension { #name : #LeLocalStore }
+
+{ #category : #'*Carp' }
+LeLocalStore >> carpLinkSettings [
+	"Answer the initialised LeCarpLinkSettings for this database"
+	<return: #LeJSLinkSettings>
+
+	^ LeJSLinkSettings new dbProperties: self
+]