18165837346

Committed 01 Oct 2025 02:39PM UTC coverage: 66.941% (+0.08%) from 66.86%

Build # 18165837346

Build Type

push

github

Committed by

web-flow

Commit Message

Merge pull request #1439 from moosetechnology/1421-tag-browser-tag-creation-should-open-a-popup

1421 tag browser tag creation should open a popup

fix #1421

Run Details

237 of 263 new or added lines in 10 files covered. (90.11%)

33 existing lines in 4 files now uncovered.

20585 of 30751 relevant lines covered (66.94%)

1.34 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

87.64

/src/MooseIDE-Tagging/MiTagManagementPage.class.st

"
The page of the TagBrowser allowing to create, select, or remove tags (left part of the browser)
"
Class {
        #name : 'MiTagManagementPage',
        #superclass : 'MiPresenter',
        #instVars : [
                'categoryManagement',
                'tagList',
                'descriptionPage',
                'tagModel',
                'tagDescriptionPage',
                'dynamicTagDescriptionPage',
                'addTagButton',
                'btnIsExtent',
                'btnIsIntent'
        ],
        #category : 'MooseIDE-Tagging-Browser',
        #package : 'MooseIDE-Tagging',
        #tag : 'Browser'
}

{ #category : 'accessing' }
MiTagManagementPage >> addTagButton [

        ^ addTagButton
]

{ #category : 'refreshing' }
MiTagManagementPage >> computeExtentTagList [

        ^ btnIsExtent state
                  ifTrue: [
                                  tagModel currentCategory
                                          ifNil: [ self specModel allTags ]
                                          ifNotNil: [ :currentTag | currentTag markedTags asMooseGroup ] ]
                  ifFalse: [ #(  ) ]
]

{ #category : 'refreshing' }
MiTagManagementPage >> computeIntentTagList [

        ^ btnIsIntent state
                  ifTrue: [
                                  tagModel currentCategory
                                          ifNil: [ self specModel dynamicTags ]
                                          ifNotNil: [ :currentCat |
                                                  self specModel dynamicTags select: [ :tag |
                                                          tag category = currentCat ] ] ]
                  ifFalse: [ #(  ) ]
]

{ #category : 'refreshing' }
MiTagManagementPage >> computeTagList [

        ^self computeExtentTagList 
         ,
         self computeIntentTagList

]

{ #category : 'initialization' }
MiTagManagementPage >> connectPresenters [

        btnIsExtent whenChangedDo: [ 
                self setIconForButton: btnIsExtent.
                self refreshTagList ].
        btnIsIntent whenChangedDo: [ 
                self setIconForButton: btnIsIntent.
                self refreshTagList ]
]

{ #category : 'action' }
MiTagManagementPage >> deleteCurrentTag [

        |tag|
        tag := tagModel deleteCurrentTag.
        self owner application removeItem: tag.
        descriptionPage hide.
        self refreshTagList
]

{ #category : 'accessing' }
MiTagManagementPage >> descriptionPage [

        ^ descriptionPage
]

{ #category : 'accessing' }
MiTagManagementPage >> dynamicTagDescriptionPage [

        ^ dynamicTagDescriptionPage
]

{ #category : 'action' }
MiTagManagementPage >> editCurrentTag [

        self owner openTagEditionForm
]

{ #category : 'accessing' }
MiTagManagementPage >> extentTagButton [

        ^ btnIsExtent
]

{ #category : 'initialization' }
MiTagManagementPage >> initializeLayout [

        | sep |
        (sep := SpRoassalPresenter new) canvas color: (Color
                         r: 40
                         g: 40
                         b: 40
                         range: 255) translucent.

        self layout: (SpBoxLayout newLeftToRight
                         spacing: 4;
                         add: (SpBoxLayout newTopToBottom
                                          spacing: 5;
                                          add: categoryManagement expand: false;
                                          add: (SpBoxLayout newLeftToRight
                                                           add: 'Tag list' asPresenter;
                                                           hAlignCenter;
                                                           yourself)
                                          expand: false;
                                          add: (SpBoxLayout newLeftToRight
                                                           spacing: 3;
                                                           add: btnIsExtent;
                                                           add: btnIsIntent;
                                                           add: addTagButton width: 30;
                                                           yourself)
                                          expand: false;
                                          add: tagList;
                                          yourself)
                         width: 200;
                         add: sep width: 2;
                         add: descriptionPage;
                         yourself)
]

{ #category : 'initialization' }
MiTagManagementPage >> initializePresenters [

        categoryManagement := self
                                      instantiate: MiTagCategoriesPresenter
                                      on: tagModel.

        tagDescriptionPage := self instantiate: MiTagExtentPage.
        dynamicTagDescriptionPage := self instantiate: MiTagIntentPage.
        descriptionPage := tagDescriptionPage.

        btnIsExtent := self newToggleButton
                               state: true;
                               icon:
                                       (Smalltalk ui icons iconNamed: #checkboxSelected);
                               label: 'Static';
                               yourself.
        btnIsIntent := self newToggleButton
                               state: false;
                               icon:
                                       (Smalltalk ui icons iconNamed: #checkboxUnselected);
                               label: 'Dynamic';
                               yourself.

        tagList := self newList.
        tagList contextMenu: self tagListMenu.
        tagList display: [ :aTag | aTag name ].
        tagList
                displayIcon: [ :aTag | self application iconForTag: aTag ];
                whenSelectionChangedDo: [ :selection |
                        selection selectedItem ifNotNil: [ :item | self setTagTo: item ] ].
        addTagButton := self newButton icon: (Smalltalk iconNamed: #smallAdd).
        addTagButton action: [ self owner openTagCreationForm ].

        self initializeLayout
]

{ #category : 'accessing' }
MiTagManagementPage >> intentTagButton [

        ^ btnIsIntent
]

{ #category : 'accessing' }
MiTagManagementPage >> model [

        self
                deprecated: 'This is a getter. Lets name it correctly.'
                transformWith: '`@receiver model' -> '`@receiver specModel'.
        ^ self specModel
]

{ #category : 'action' }
MiTagManagementPage >> preparePageFor: aTag [

        aTag isIntent ifTrue: [ 
                self layout replace: descriptionPage with: dynamicTagDescriptionPage.
                descriptionPage := dynamicTagDescriptionPage.
                ^ self ].
        self layout replace: descriptionPage with: tagDescriptionPage.
        descriptionPage := tagDescriptionPage
]

{ #category : 'refreshing' }
MiTagManagementPage >> refresh [

        self refreshTagList.
        self refreshCategoryList.
        self refreshDescriptionPage
]

{ #category : 'refreshing' }
MiTagManagementPage >> refreshCategoryList [

        categoryManagement refreshCategoryList
]

{ #category : 'refreshing' }
MiTagManagementPage >> refreshDescriptionPage [

        self setRightPart: descriptionPage.
        descriptionPage refresh
]

{ #category : 'refreshing' }
MiTagManagementPage >> refreshTagList [

        tagList items:
                (self computeTagList asArray sort: [ :t1 :t2 | t1 name <= t2 name ]).

        self specModel currentTag ifNotNil: [ :currentTag |
                tagList selectItem: currentTag ]
]

{ #category : 'initialization' }
MiTagManagementPage >> refreshTaggedEntitiesList [

        descriptionPage refreshTaggedEntitiesList
]

{ #category : 'action' }
MiTagManagementPage >> removeCategory [

        self specModel deleteCurrentCategory.
        self refreshCategoryList
]

{ #category : 'accessing' }
MiTagManagementPage >> selectedItems [

        ^ tagDescriptionPage selectedItems
]

{ #category : 'initialization' }
MiTagManagementPage >> setIconForButton: aBtn [

        aBtn icon: (Smalltalk ui icons iconNamed: (aBtn state
                                  ifTrue: [ #checkboxSelected ]
                                  ifFalse: [ #checkboxUnselected ]))
]

{ #category : 'initialization' }
MiTagManagementPage >> setModelBeforeInitialization: aTagModel [

        tagModel := aTagModel
]

{ #category : 'initialization' }
MiTagManagementPage >> setRightPart: aSpPresenter [
        "temporary hack, the descriptionPage should not be in this class but in the MiTagBrowser
         We need to replace the right part of the window (descriptionPage) with the new presenter
         this part is the 3rd presenter in the layout
         So if this right part is not the same as aSpPresenter,
         we remove it and then add the correct one"

        (layout presenters third = aSpPresenter) ifTrue: [ ^self ].

        layout remove: layout presenters third.
        layout add: aSpPresenter 

]

{ #category : 'action' }
MiTagManagementPage >> setTagTo: aTag [

        self owner setTagTo: aTag.
        self preparePageFor: aTag.
        descriptionPage setTag: aTag.
        descriptionPage show.
        self refreshDescriptionPage.
        self update
]

{ #category : 'initialization' }
MiTagManagementPage >> showNoMooseModel [

        self setRightPart: (SpPresenter new
                layout: (SpBoxLayout newTopToBottom
                        vAlignCenter;
                        hAlignCenter;
                        add: 'No available moose model in selected buses.';
                        add: 'Propagate entities or moose model on selected buses.';
                        yourself);
                yourself)
]

{ #category : 'accessing' }
MiTagManagementPage >> specModel [

        ^ owner specModel
]

{ #category : 'accessing' }
MiTagManagementPage >> tagList [

        ^ tagList
]

{ #category : 'initialization' }
MiTagManagementPage >> tagListMenu [

        ^ self newMenu
                  addGroup: [ :aGroup | 
                          aGroup
                                  addItem: [ :anItem | 
                                          anItem
                                                  name: 'Edit tag';
                                                  iconName: #edit;
                                                  action: [ self editCurrentTag ] ];
                                  addItem: [ :anItem | 
                                          anItem
                                                  name: 'Delete';
                                                  iconName: #glamorousClose;
                                                  action: [ self deleteCurrentTag ] ] ]
]

{ #category : 'accessing' }
MiTagManagementPage >> tagModel [

        ^ owner specModel
]

1	"
2	The page of the TagBrowser allowing to create, select, or remove tags (left part of the browser)
3	"
4	Class {
5	#name : 'MiTagManagementPage',
6	#superclass : 'MiPresenter',
7	#instVars : [
8	'categoryManagement',
9	'tagList',
10	'descriptionPage',
11	'tagModel',
12	'tagDescriptionPage',
13	'dynamicTagDescriptionPage',
14	'addTagButton',
15	'btnIsExtent',
16	'btnIsIntent'
17	],
18	#category : 'MooseIDE-Tagging-Browser',
19	#package : 'MooseIDE-Tagging',
20	#tag : 'Browser'
21	}
22
23	{ #category : 'accessing' }
UNCOV 24	MiTagManagementPage >> addTagButton [	×
UNCOV 25		×
UNCOV 26	^ addTagButton	×
UNCOV 27	]	×
28
29	{ #category : 'refreshing' }
30	MiTagManagementPage >> computeExtentTagList [	2✔
31		2✔
32	^ btnIsExtent state	2✔
33	ifTrue: [	2✔
34	tagModel currentCategory	2✔
35	ifNil: [ self specModel allTags ]	2✔
36	ifNotNil: [ :currentTag \| currentTag markedTags asMooseGroup ] ]	2✔
37	ifFalse: [ #( ) ]	2✔
38	]	2✔
39
40	{ #category : 'refreshing' }
41	MiTagManagementPage >> computeIntentTagList [	2✔
42		2✔
43	^ btnIsIntent state	2✔
44	ifTrue: [	2✔
45	tagModel currentCategory	2✔
46	ifNil: [ self specModel dynamicTags ]	2✔
47	ifNotNil: [ :currentCat \|	2✔
48	self specModel dynamicTags select: [ :tag \|	2✔
49	tag category = currentCat ] ] ]	2✔
50	ifFalse: [ #( ) ]	2✔
51	]	2✔
52
53	{ #category : 'refreshing' }
54	MiTagManagementPage >> computeTagList [	2✔
55		2✔
56	^self computeExtentTagList	2✔
57	,	2✔
58	self computeIntentTagList	2✔
59		2✔
60	]	2✔
61
62	{ #category : 'initialization' }
63	MiTagManagementPage >> connectPresenters [	2✔
64		2✔
65	btnIsExtent whenChangedDo: [	2✔
66	self setIconForButton: btnIsExtent.	2✔
67	self refreshTagList ].	2✔
68	btnIsIntent whenChangedDo: [	2✔
69	self setIconForButton: btnIsIntent.	2✔
70	self refreshTagList ]	2✔
71	]	2✔
72
73	{ #category : 'action' }
74	MiTagManagementPage >> deleteCurrentTag [	2✔
75		2✔
76	\|tag\|	2✔
77	tag := tagModel deleteCurrentTag.	2✔
78	self owner application removeItem: tag.	2✔
79	descriptionPage hide.	2✔
80	self refreshTagList	2✔
81	]	2✔
82
83	{ #category : 'accessing' }
84	MiTagManagementPage >> descriptionPage [	2✔
85		2✔
86	^ descriptionPage	2✔
87	]	2✔
88
89	{ #category : 'accessing' }
90	MiTagManagementPage >> dynamicTagDescriptionPage [	×
91		×
92	^ dynamicTagDescriptionPage	×
93	]	×
94
95	{ #category : 'action' }
96	MiTagManagementPage >> editCurrentTag [	×
97		×
98	self owner openTagEditionForm	×
99	]	×
100
101	{ #category : 'accessing' }
102	MiTagManagementPage >> extentTagButton [	2✔
103		2✔
104	^ btnIsExtent	2✔
105	]	2✔
106
107	{ #category : 'initialization' }
108	MiTagManagementPage >> initializeLayout [	2✔
109		2✔
110	\| sep \|	2✔
111	(sep := SpRoassalPresenter new) canvas color: (Color	2✔
112	r: 40	2✔
113	g: 40	2✔
114	b: 40	2✔
115	range: 255) translucent.	2✔
116		2✔
117	self layout: (SpBoxLayout newLeftToRight	2✔
118	spacing: 4;	2✔
119	add: (SpBoxLayout newTopToBottom	2✔
120	spacing: 5;	2✔
121	add: categoryManagement expand: false;	2✔
122	add: (SpBoxLayout newLeftToRight	2✔
123	add: 'Tag list' asPresenter;	2✔
124	hAlignCenter;	2✔
125	yourself)	2✔
126	expand: false;	2✔
127	add: (SpBoxLayout newLeftToRight	2✔
128	spacing: 3;	2✔
129	add: btnIsExtent;	2✔
130	add: btnIsIntent;	2✔
131	add: addTagButton width: 30;	2✔
132	yourself)	2✔
133	expand: false;	2✔
134	add: tagList;	2✔
135	yourself)	2✔
136	width: 200;	2✔
137	add: sep width: 2;	2✔
138	add: descriptionPage;	2✔
139	yourself)	2✔
140	]	2✔
141
142	{ #category : 'initialization' }
143	MiTagManagementPage >> initializePresenters [	2✔
144		2✔
145	categoryManagement := self	2✔
146	instantiate: MiTagCategoriesPresenter	2✔
147	on: tagModel.	2✔
148		2✔
149	tagDescriptionPage := self instantiate: MiTagExtentPage.	2✔
150	dynamicTagDescriptionPage := self instantiate: MiTagIntentPage.	2✔
151	descriptionPage := tagDescriptionPage.	2✔
152		2✔
153	btnIsExtent := self newToggleButton	2✔
154	state: true;	2✔
155	icon:	2✔
156	(Smalltalk ui icons iconNamed: #checkboxSelected);	2✔
157	label: 'Static';	2✔
158	yourself.	2✔
159	btnIsIntent := self newToggleButton	2✔
160	state: false;	2✔
161	icon:	2✔
162	(Smalltalk ui icons iconNamed: #checkboxUnselected);	2✔
163	label: 'Dynamic';	2✔
164	yourself.	2✔
165		2✔
166	tagList := self newList.	2✔
167	tagList contextMenu: self tagListMenu.	2✔
168	tagList display: [ :aTag \| aTag name ].	2✔
169	tagList	2✔
170	displayIcon: [ :aTag \| self application iconForTag: aTag ];	2✔
171	whenSelectionChangedDo: [ :selection \|	2✔
172	selection selectedItem ifNotNil: [ :item \| self setTagTo: item ] ].	2✔
173	addTagButton := self newButton icon: (Smalltalk iconNamed: #smallAdd).	2✔
174	addTagButton action: [ self owner openTagCreationForm ].	2✔
175		2✔
176	self initializeLayout	2✔
177	]	2✔
178
179	{ #category : 'accessing' }
180	MiTagManagementPage >> intentTagButton [	2✔
181		2✔
182	^ btnIsIntent	2✔
183	]	2✔
184
185	{ #category : 'accessing' }
186	MiTagManagementPage >> model [	×
187		×
188	self	×
189	deprecated: 'This is a getter. Lets name it correctly.'	×
190	transformWith: '`@receiver model' -> '`@receiver specModel'.	×
191	^ self specModel	×
192	]	×
193
194	{ #category : 'action' }
195	MiTagManagementPage >> preparePageFor: aTag [	2✔
196		2✔
197	aTag isIntent ifTrue: [	2✔
198	self layout replace: descriptionPage with: dynamicTagDescriptionPage.	2✔
199	descriptionPage := dynamicTagDescriptionPage.	2✔
200	^ self ].	2✔
201	self layout replace: descriptionPage with: tagDescriptionPage.	2✔
202	descriptionPage := tagDescriptionPage	2✔
203	]	2✔
204
205	{ #category : 'refreshing' }
206	MiTagManagementPage >> refresh [	2✔
207		2✔
208	self refreshTagList.	2✔
209	self refreshCategoryList.	2✔
210	self refreshDescriptionPage	2✔
211	]	2✔
212
213	{ #category : 'refreshing' }
214	MiTagManagementPage >> refreshCategoryList [	2✔
215		2✔
216	categoryManagement refreshCategoryList	2✔
217	]	2✔
218
219	{ #category : 'refreshing' }
220	MiTagManagementPage >> refreshDescriptionPage [	2✔
221		2✔
222	self setRightPart: descriptionPage.	2✔
223	descriptionPage refresh	2✔
224	]	2✔
225
226	{ #category : 'refreshing' }
227	MiTagManagementPage >> refreshTagList [	2✔
228		2✔
229	tagList items:	2✔
230	(self computeTagList asArray sort: [ :t1 :t2 \| t1 name <= t2 name ]).	2✔
231		2✔
232	self specModel currentTag ifNotNil: [ :currentTag \|	2✔
233	tagList selectItem: currentTag ]	2✔
234	]	2✔
235
236	{ #category : 'initialization' }
237	MiTagManagementPage >> refreshTaggedEntitiesList [	2✔
238		2✔
239	descriptionPage refreshTaggedEntitiesList	2✔
240	]	2✔
241
242	{ #category : 'action' }
243	MiTagManagementPage >> removeCategory [	×
244		×
245	self specModel deleteCurrentCategory.	×
246	self refreshCategoryList	×
247	]	×
248
249	{ #category : 'accessing' }
250	MiTagManagementPage >> selectedItems [	×
251		×
252	^ tagDescriptionPage selectedItems	×
253	]	×
254
255	{ #category : 'initialization' }
256	MiTagManagementPage >> setIconForButton: aBtn [	2✔
257		2✔
258	aBtn icon: (Smalltalk ui icons iconNamed: (aBtn state	2✔
259	ifTrue: [ #checkboxSelected ]	2✔
260	ifFalse: [ #checkboxUnselected ]))	2✔
261	]	2✔
262
263	{ #category : 'initialization' }
264	MiTagManagementPage >> setModelBeforeInitialization: aTagModel [	2✔
265		2✔
266	tagModel := aTagModel	2✔
267	]	2✔
268
269	{ #category : 'initialization' }
270	MiTagManagementPage >> setRightPart: aSpPresenter [	2✔
271	"temporary hack, the descriptionPage should not be in this class but in the MiTagBrowser	2✔
272	We need to replace the right part of the window (descriptionPage) with the new presenter	2✔
273	this part is the 3rd presenter in the layout	2✔
274	So if this right part is not the same as aSpPresenter,	2✔
275	we remove it and then add the correct one"	2✔
276		2✔
277	(layout presenters third = aSpPresenter) ifTrue: [ ^self ].	2✔
278		2✔
279	layout remove: layout presenters third.	2✔
280	layout add: aSpPresenter	2✔
281		2✔
282	]	2✔
283
284	{ #category : 'action' }
285	MiTagManagementPage >> setTagTo: aTag [	2✔
286		2✔
287	self owner setTagTo: aTag.	2✔
288	self preparePageFor: aTag.	2✔
289	descriptionPage setTag: aTag.	2✔
290	descriptionPage show.	2✔
291	self refreshDescriptionPage.	2✔
292	self update	2✔
293	]	2✔
294
295	{ #category : 'initialization' }
296	MiTagManagementPage >> showNoMooseModel [	2✔
297		2✔
298	self setRightPart: (SpPresenter new	2✔
299	layout: (SpBoxLayout newTopToBottom	2✔
300	vAlignCenter;	2✔
301	hAlignCenter;	2✔
302	add: 'No available moose model in selected buses.';	2✔
303	add: 'Propagate entities or moose model on selected buses.';	2✔
304	yourself);	2✔
305	yourself)	2✔
306	]	2✔
307
308	{ #category : 'accessing' }
309	MiTagManagementPage >> specModel [	2✔
310		2✔
311	^ owner specModel	2✔
312	]	2✔
313
314	{ #category : 'accessing' }
315	MiTagManagementPage >> tagList [	2✔
316		2✔
317	^ tagList	2✔
318	]	2✔
319
320	{ #category : 'initialization' }
321	MiTagManagementPage >> tagListMenu [	2✔
322		2✔
323	^ self newMenu	2✔
324	addGroup: [ :aGroup \|	2✔
325	aGroup	2✔
326	addItem: [ :anItem \|	2✔
327	anItem	2✔
328	name: 'Edit tag';	2✔
329	iconName: #edit;	2✔
330	action: [ self editCurrentTag ] ];	2✔
331	addItem: [ :anItem \|	2✔
332	anItem	2✔
333	name: 'Delete';	2✔
334	iconName: #glamorousClose;	2✔
335	action: [ self deleteCurrentTag ] ] ]	2✔
336	]	2✔
337
338	{ #category : 'accessing' }
UNCOV 339	MiTagManagementPage >> tagModel [	×
UNCOV 340		×
UNCOV 341	^ owner specModel	×
UNCOV 342	]	×

moosetechnology / MooseIDE / 18165837346

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous