diff --git a/src/Carp/CarpDefinitionsElement.class.st b/src/Carp/CarpDefinitionsElement.class.st new file mode 100644 index 0000000..4ae2e87 --- /dev/null +++ b/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 ] +] diff --git a/src/Carp/CarpModule.class.st b/src/Carp/CarpModule.class.st index 978860f..e95f074 100644 --- a/src/Carp/CarpModule.class.st +++ b/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 [ + + + ^ 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 ] ] +] diff --git a/src/Carp/CarpModuleCoderElement.class.st b/src/Carp/CarpModuleCoderElement.class.st index 9161043..3c7a236 100644 --- a/src/Carp/CarpModuleCoderElement.class.st +++ b/src/Carp/CarpModuleCoderElement.class.st @@ -41,7 +41,7 @@ CarpModuleCoderElement >> buildContentTabs [ { #category : #accessing } CarpModuleCoderElement >> buildDefinitionElement [ - ^ BrExpander new + ^ CarpDefinitionsElement new module: self module ] { #category : #accessing } diff --git a/src/Carp/GtSmaCCParserStyler.extension.st b/src/Carp/GtSmaCCParserStyler.extension.st new file mode 100644 index 0000000..0a295a8 --- /dev/null +++ b/src/Carp/GtSmaCCParserStyler.extension.st @@ -0,0 +1,68 @@ +Extension { #name : #GtSmaCCParserStyler } + +{ #category : #'*Carp' } +GtSmaCCParserStyler class >> carpStyler: aParserClass [ + + + ^ (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 ]) } +] diff --git a/src/Carp/LeLocalStore.extension.st b/src/Carp/LeLocalStore.extension.st new file mode 100644 index 0000000..e396e83 --- /dev/null +++ b/src/Carp/LeLocalStore.extension.st @@ -0,0 +1,9 @@ +Extension { #name : #LeLocalStore } + +{ #category : #'*Carp' } +LeLocalStore >> carpLinkSettings [ + "Answer the initialised LeCarpLinkSettings for this database" + + + ^ LeJSLinkSettings new dbProperties: self +]