Dev stage fixes

src/Pyramid-Bloc/PyramidLibraryElement.class.st

@@ -4,7 +4,8 @@ Class {
 	#instVars : [
 		'name',
 		'icon',
-		'block'
+		'block',
+		'status'
 	],
 	#category : #'Pyramid-Bloc-plugin-navigation'
 }
@@ -85,3 +86,15 @@ PyramidLibraryElement >> name: anObject [
 
 	name := anObject
 ]
+
+{ #category : #accessing }
+PyramidLibraryElement >> status [
+
+	^ status ifNil: [ #ok ]
+]
+
+{ #category : #accessing }
+PyramidLibraryElement >> status: aSymbol [
+
+	status := aSymbol
+]

src/Pyramid-Toplo/PyramidToploThemePlugin.class.st

@@ -110,30 +110,77 @@ PyramidToploThemePlugin class >> toploIconThemeCategoryFromClass: aClass withCat
 PyramidToploThemePlugin class >> toploLibraryCategory [
 
 	<pyramidLibraryCategory: 1>
-	| classes elements |
-	classes := ToElement allSubclasses , { ToElement }.
-	elements := classes
-		            reject: [ :each |
-			            each isAbstract or: [
-				            (each name findString: 'Abstract') > 0 or: [
-					            [
-					            each new.
-					            false ]
-						            on: Error
-						            do: [ true ] ] ] ]
-		            thenCollect: [ :class |
+	| allowedClasses allClasses elements knownNotUsable testClass okElements unserializedElements |
+	allowedClasses := {
+		                  ToButton.
+		                  ToLabel.
+		                  ToImage.
+		                  ToAlbum.
+		                  ToTextField.
+		                  ToListElement. }.
+	knownNotUsable := #( #ToCircularMenuInnerElement
+	                     #ToCircularMenuList #ToExPicsumNode
+	                     #ToAnimatedIcon ).
+	testClass := Smalltalk at: #ToSerializerTest.
+	allClasses := ToElement allSubclasses , { ToElement }.
+	allClasses := allClasses reject: [ :each |
+		              each isAbstract or: [
+			              (each name findString: 'Abstract') > 0 ] ].
+	elements := allClasses collect: [ :class |
+			            | notUsable serializable status |
+			            notUsable := [
+				                         class new.
+				                         false ]
+				                         on: Error
+				                         do: [ :e | true ].
+			            notUsable := notUsable or: [
+				                         knownNotUsable includes:
+					                         class name asSymbol ].
+			            serializable := [
+				                            | suite prefix |
+				                            prefix := 'test' , class name.
+				                            suite := testClass suite tests
+					                                     select: [ :t |
+					                                     t selector beginsWith:
+						                                     prefix ].
+				                            suite isNotEmpty ]
+				                            on: Error
+				                            do: [ false ].
+			            status := notUsable
+				                      ifTrue: [ #notUsable ]
+				                      ifFalse: [
+						                      ((allowedClasses includes: class) and: [
+							                       serializable ])
+							                      ifTrue: [ #ok ]
+							                      ifFalse: [ #unstable ] ].
 			            PyramidLibraryElement new
 				            icon:
-					            (Smalltalk ui icons iconNamed: class systemIconName);
+					            (Smalltalk ui icons iconNamed: (status = #notUsable
+								              ifTrue: [ #error ]
+								              ifFalse: [
+										              status = #unstable 
+											              ifTrue: [ #warning ]
+											              ifFalse: [ class systemIconName ] ]));
 				            name: class name;
 				            block: [ { class new } ];
+				            status: status;
 				            yourself ].
-
-	^ { (PyramidLibraryCategory new
-		   name: 'Toplo';
-		   icon: (Smalltalk ui icons iconNamed: #box);
-		   elements: (elements sorted: [ :a :b | a name < b name ]);
-		   yourself) }
+	elements := elements reject: [ :e | e status = #notUsable ].
+	okElements := elements select: [ :e | e status = #ok ].
+	unserializedElements := elements select: [ :e |
+		                        e status = #unstable ].
+	^ {
+		  (PyramidLibraryCategory new
+			   name: 'Toplo';
+			   icon: (Smalltalk ui icons iconNamed: #box);
+			   elements: (okElements sorted: [ :a :b | a name < b name ]);
+			   yourself).
+		  (PyramidLibraryCategory new
+			   name: 'Unstable';
+			   icon: (Smalltalk ui icons iconNamed: #warning);
+			   elements:
+				   (unserializedElements sorted: [ :a :b | a name < b name ]);
+			   yourself) }
 ]
 
 { #category : #adding }