diff --git a/src/Pyramid-Bloc/PyramidLibraryElement.class.st b/src/Pyramid-Bloc/PyramidLibraryElement.class.st index 08385a1..27ba1e4 100644 --- a/src/Pyramid-Bloc/PyramidLibraryElement.class.st +++ b/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 +] diff --git a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st index b1164fa..bc3b334 100644 --- a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st +++ b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st @@ -110,30 +110,77 @@ PyramidToploThemePlugin class >> toploIconThemeCategoryFromClass: aClass withCat PyramidToploThemePlugin class >> toploLibraryCategory [ - | 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 }