245 lines
7.0 KiB
Smalltalk
245 lines
7.0 KiB
Smalltalk
Class {
|
|
#name : #CarpModule,
|
|
#superclass : #CarpExpression,
|
|
#instVars : [
|
|
'uses',
|
|
'expressions',
|
|
'name',
|
|
'tests'
|
|
],
|
|
#category : #'Carp-IDE'
|
|
}
|
|
|
|
{ #category : #'instance creation' }
|
|
CarpModule class >> named: aString [
|
|
^ self new name: aString
|
|
]
|
|
|
|
{ #category : #accessing }
|
|
CarpModule >> addExpression: anExpression [
|
|
expressions add: anExpression
|
|
]
|
|
|
|
{ #category : #accessing }
|
|
CarpModule >> addTest: aTest [
|
|
tests add: aTest
|
|
]
|
|
|
|
{ #category : #accessing }
|
|
CarpModule >> addUse: aString [
|
|
uses add: aString
|
|
]
|
|
|
|
{ #category : #coders }
|
|
CarpModule >> carpCoderCommentsFor: aView [
|
|
|
|
<gtModuleView>
|
|
^ aView explicit
|
|
title: 'Documentation';
|
|
tooltip: 'Module Documentation';
|
|
priority: 30;
|
|
disableAsync;
|
|
stencil: [
|
|
| snippet snippetViewModel |
|
|
snippet := LeTextSnippet string: self documentation.
|
|
snippetViewModel := snippet asSnippetViewModel.
|
|
snippetViewModel coderViewModel addShortcut:
|
|
(BrEditorShortcut lineEnding combination:
|
|
(LeSnippetElement keyboardShortcut: #NewLine)).
|
|
snippetViewModel coderViewModel addShortcut:
|
|
(BlShortcutWithAction new
|
|
combination: BlKeyCombination primaryS;
|
|
action: [ :anEvent |
|
|
self documentation: anEvent currentTarget text asString ]).
|
|
((snippetViewModel snippetView needsEmbellishments: false)
|
|
asElement snippetViewModel: snippetViewModel) vMatchParent ];
|
|
actionButtonIcon: BrGlamorousVectorIcons accept
|
|
tooltip: 'Save documentation'
|
|
action: [ :aToggle :aTab |
|
|
self documentation:
|
|
aTab viewContentElement children first text asString ];
|
|
actionButtonIcon: BrGlamorousVectorIcons cancel
|
|
tooltip: 'Discard documentation'
|
|
action: [ :aToggle :aTab |
|
|
aTab viewContentElement children first text: self documentation ]
|
|
]
|
|
|
|
{ #category : #coders }
|
|
CarpModule >> carpCoderStreamingMethodsFor: aView context: aPhlowContext [
|
|
<gtModuleView>
|
|
| aMethodsCoder aMethodsCoderViewModel aNewMethodCoderHolder |
|
|
|
|
aNewMethodCoderHolder := ValueHolder new.
|
|
|
|
^ aView explicit
|
|
priority: 9;
|
|
title: 'Methods';
|
|
disableAsync;
|
|
actionDropdownButtonDo: [ :aDrodownAction |
|
|
aDrodownAction dropdown
|
|
icon: BrGlamorousVectorIcons add;
|
|
tooltip: 'Add new expression';
|
|
content: [ :aButton |
|
|
| aNewMethodCoder aNewMethodCoderViewModel aHandler |
|
|
|
|
aNewMethodCoderHolder contents
|
|
ifNotNil: [ :aContents |
|
|
aNewMethodCoderViewModel := aContents ]
|
|
ifNil: [
|
|
|
|
aNewMethodCoder := GtCarpCoderModel new.
|
|
|
|
aNewMethodCoderViewModel := aNewMethodCoder asCoderViewModel.
|
|
aNewMethodCoderViewModel
|
|
withoutHeader;
|
|
expanded: true;
|
|
focused: true;
|
|
moveCursorAtEnd.
|
|
|
|
aNewMethodCoderHolder contents: aNewMethodCoderViewModel.
|
|
|
|
aHandler := GtPharoNewMethodCodeSavedHandler new
|
|
methodsCoderViewModel: aMethodsCoderViewModel;
|
|
element: aButton;
|
|
methodCoderHolder: aNewMethodCoderHolder.
|
|
|
|
aNewMethodCoderViewModel weak
|
|
when: GtMethodCoderSaved
|
|
send: #onAnnouncement:
|
|
to: aHandler ].
|
|
|
|
(GtExpandedOnlyCoderElement new coderViewModel: aNewMethodCoderViewModel)
|
|
hExact: 300;
|
|
vFitContent;
|
|
background: Color white;
|
|
padding: (BlInsets all: 5);
|
|
addAptitude: BrGlamorousFocusableShadowAptitude new ];
|
|
name: #'button--add-new-expression'];
|
|
stencil: [ CarpStreamingMethodsCoderElement forModule: self ]
|
|
]
|
|
|
|
{ #category : #accessing }
|
|
CarpModule >> expressions [
|
|
^ expressions
|
|
]
|
|
|
|
{ #category : #initialization }
|
|
CarpModule >> initialize [
|
|
uses := Set new.
|
|
expressions := OrderedCollection new.
|
|
tests := OrderedCollection new.
|
|
]
|
|
|
|
{ #category : #converting }
|
|
CarpModule >> name [
|
|
^ name
|
|
]
|
|
|
|
{ #category : #accessing }
|
|
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 [
|
|
|
|
^ String streamContents: [ :aStream |
|
|
aStream << '(doc ' << self name << ' "' << self documentation
|
|
<< '")' << Character lf.
|
|
aStream << '(defmodule ' << self name << ' ' << (uses
|
|
ifEmpty: [ '' ]
|
|
ifNotEmpty: [
|
|
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 : #magritte }
|
|
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 ] ]
|
|
]
|