Skip to content

Commit

Permalink
Multiple changes:
Browse files Browse the repository at this point in the history
- Add missing class extensions
- Add CarpDefinitionsElement and add it to module coder [fixes #9]
- Add tests stub to carp module
  • Loading branch information
hellerve committed Apr 18, 2022
1 parent 341e39b commit 8ed61d6
Show file tree
Hide file tree
Showing 5 changed files with 271 additions and 3 deletions.
97 changes: 97 additions & 0 deletions src/Carp/CarpDefinitionsElement.class.st
Original file line number Diff line number Diff line change
@@ -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 ]
]
98 changes: 96 additions & 2 deletions src/Carp/CarpModule.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,8 @@ Class {
#instVars : [
'uses',
'expressions',
'name'
'name',
'tests'
],
#category : #'Carp-IDE'
}
Expand All @@ -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
Expand Down Expand Up @@ -121,6 +127,7 @@ CarpModule >> expressions [
CarpModule >> initialize [
uses := Set new.
expressions := OrderedCollection new.
tests := OrderedCollection new.
]

{ #category : #converting }
Expand All @@ -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 [

Expand All @@ -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 ] ]
]
2 changes: 1 addition & 1 deletion src/Carp/CarpModuleCoderElement.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@ CarpModuleCoderElement >> buildContentTabs [

{ #category : #accessing }
CarpModuleCoderElement >> buildDefinitionElement [
^ BrExpander new
^ CarpDefinitionsElement new module: self module
]

{ #category : #accessing }
Expand Down
68 changes: 68 additions & 0 deletions src/Carp/GtSmaCCParserStyler.extension.st
Original file line number Diff line number Diff line change
@@ -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 ]) }
]
9 changes: 9 additions & 0 deletions src/Carp/LeLocalStore.extension.st
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
Extension { #name : #LeLocalStore }

{ #category : #'*Carp' }
LeLocalStore >> carpLinkSettings [
"Answer the initialised LeCarpLinkSettings for this database"
<return: #LeJSLinkSettings>

^ LeJSLinkSettings new dbProperties: self
]

0 comments on commit 8ed61d6

Please sign in to comment.