Merge 438ba4f

feenkcom · Oct 21, 2024 · c36ca3f · c36ca3f
2 parents fdabec6 + 438ba4f
commit c36ca3f
Show file tree

Hide file tree

Showing 3 changed files with 91 additions and 2 deletions.
diff --git a/src/GT-PackageWithExtensions/GtCoderDummySuperclass.extension.st b/src/GT-PackageWithExtensions/GtCoderDummySuperclass.extension.st
@@ -0,0 +1,9 @@
+Extension { #name : #GtCoderDummySuperclass }
+
+{ #category : #'*GT-PackageWithExtensions' }
+GtCoderDummySuperclass class >> classSideExtension [
+]
+
+{ #category : #'*GT-PackageWithExtensions' }
+GtCoderDummySuperclass >> instanceSideExtension [
+]
diff --git a/src/GToolkit-Pharo-Coder-Examples/GtCoderNavigationPackagesTagsClassesModelExamples.class.st b/src/GToolkit-Pharo-Coder-Examples/GtCoderNavigationPackagesTagsClassesModelExamples.class.st
@@ -209,11 +209,71 @@ GtCoderNavigationPackagesTagsClassesModelExamples >> navigateToClass_03_selectCl
 	^ aModel
 ]
 
+{ #category : #'examples - navigate to extensions' }
+GtCoderNavigationPackagesTagsClassesModelExamples >> navigateToPackageWithExtensions_01_selectPackage [
+	<gtExample>
+	| aModel classesToShow |
+
+	aModel := self defaultModel.
+	aModel selectPackage: self packageWithExtensions.
+
+	self assert: aModel hasSelectedPackage.
+	self assert: aModel selectedPackage equals: self packageWithExtensions.
+
+	self assert: aModel hasSelectedTag not.
+	self assert: aModel hasSelectedClass not.
+
+	classesToShow := aModel classesToShow.
+	self assert: (classesToShow includes: self dummySuperclass).
+	self assert: (classesToShow includes: self dummySuperclass class) not.
+
+	self assertNoProtocolsNoSlotsNoMethods: aModel.
+
+	^ aModel
+]
+
+{ #category : #'examples - navigate to extensions' }
+GtCoderNavigationPackagesTagsClassesModelExamples >> navigateToPackageWithExtensions_02_selectTag [
+	<gtExample>
+	| aModel aTag classesToShow |
+
+	aModel := self navigateToPackageWithExtensions_01_selectPackage.
+
+	aTag := GtCoderPackageExtensionTag forPackage: self packageWithExtensions.
+
+	aModel selectPackageTag: aTag.
+
+	self assert: aModel hasSelectedPackage.
+	self assert: aModel selectedPackage equals: self packageWithExtensions.
+	self assert: aModel hasSelectedTag.
+	self assert: aModel selectedTag equals: aTag.
+
+	self assert: aModel hasSelectedClass not.
+
+	classesToShow := aModel classesToShow.
+	self assert: (classesToShow includes: self dummySuperclass).
+	self assert: (classesToShow includes: self dummySuperclass class) not.
+
+	self assertNoProtocolsNoSlotsNoMethods: aModel.
+
+	^ aModel
+]
+
+{ #category : #utilities }
+GtCoderNavigationPackagesTagsClassesModelExamples >> packageNameWithExtensions [
+	^ 'GT-PackageWithExtensions'
+]
+
 { #category : #utilities }
 GtCoderNavigationPackagesTagsClassesModelExamples >> packageNameWithSuperclasses [
 	^ 'GT-PackageWithSuperclasses'
 ]
 
+{ #category : #utilities }
+GtCoderNavigationPackagesTagsClassesModelExamples >> packageWithExtensions [
+	^ self packageNameWithExtensions asPackage
+]
+
 { #category : #utilities }
 GtCoderNavigationPackagesTagsClassesModelExamples >> packageWithSuperclasses [
 	^ self packageNameWithSuperclasses asPackage

diff --git a/src/GToolkit-Pharo-Coder/GtCoderNavigationPackagesTagsClassesModel.class.st b/src/GToolkit-Pharo-Coder/GtCoderNavigationPackagesTagsClassesModel.class.st
@@ -106,8 +106,8 @@ GtCoderNavigationPackagesTagsClassesModel >> classesToShow [
 		ifFalse: [ ^ #() ].
 
 	^ self hasSelectedTag
-		ifTrue: [ self selectedTag classes ]
-		ifFalse: [ self selectedPackage definedClasses ]
+		ifTrue: [ self privateClassesInPackageTag: self selectedTag ]
+		ifFalse: [ self privateClassesInPackage: self selectedPackage ]
 ]
 
 { #category : #'private - accessing' }
@@ -499,6 +499,26 @@ GtCoderNavigationPackagesTagsClassesModel >> packagesToShow [
 	^ RPackageOrganizer default gtSortedPackages
 ]
 
+{ #category : #'private - accessing' }
+GtCoderNavigationPackagesTagsClassesModel >> privateClassesInPackage: aPackage [
+	| allClasses |
+	allClasses := aPackage definedClasses asSet.
+	aPackage extendedClasses do: [ :eachClass |
+		allClasses add: eachClass instanceSide ].
+	^ allClasses asArray
+]
+
+{ #category : #'private - accessing' }
+GtCoderNavigationPackagesTagsClassesModel >> privateClassesInPackageTag: aPackageTag [
+	aPackageTag = (GtCoderPackageExtensionTag forPackage: aPackageTag package)
+		ifTrue: [
+			^ (aPackageTag package extendedClasses
+				collect: [ :eachClass | eachClass instanceSide ])
+					copyWithoutDuplicates ].
+
+	^ aPackageTag classes
+]
+
 { #category : #'private - selection' }
 GtCoderNavigationPackagesTagsClassesModel >> privateJustDeselectClass [
 	"Just deselect any currently selected class and notify about the changes/