Merge pull request #849 from pharo-graphics/DemoBrowser

Pass on demo browser and its model

Author: tinchodias

src/Bloc-Demo/BlDemoBasicNode.class.st

@@ -12,11 +12,12 @@ Class {
 	#category : #'Bloc-Demo-DemoPresenterNodes'
 }
 
-{ #category : #'as yet unclassified' }
+{ #category : #'instance creation' }
 BlDemoBasicNode class >> withItem: anObject [
 
-	^ self new item: anObject 
-	
+	^ self new
+		initializeWithItem: anObject;
+		yourself
 ]
 
 { #category : #adding }
@@ -37,10 +38,13 @@ BlDemoBasicNode >> children: anOrderedCollection [
 ]
 
 { #category : #initialization }
-BlDemoBasicNode >> initialize [
+BlDemoBasicNode >> initializeWithItem: anObject [
+
+	self initialize.
+
+	children := OrderedCollection new.
 
-	super initialize.
-	children := OrderedCollection new
+	item := anObject
 ]
 
 { #category : #accessing }
@@ -49,13 +53,8 @@ BlDemoBasicNode >> item [
 ]
 
 { #category : #accessing }
-BlDemoBasicNode >> item: anObject [
-
-	item := anObject 
-]
+BlDemoBasicNode >> name [
 
-{ #category : #accessing }
-BlDemoBasicNode >> name [ 
 	^ item name
 ]
 
@@ -69,3 +68,13 @@ BlDemoBasicNode >> parent: aNode [
 
 	parent := aNode 
 ]
+
+{ #category : #printing }
+BlDemoBasicNode >> printOn: aStream [
+
+	super printOn: aStream.
+	aStream
+		nextPutAll: '(';
+		print: item;
+		nextPutAll: ')'
+]

src/Bloc-Demo/BlDemoBasicNodeTest.class.st

@@ -1,31 +1,29 @@
 Class {
 	#name : #BlDemoBasicNodeTest,
 	#superclass : #TestCase,
-	#instVars : [
-		'class',
-		'class2'
-	],
 	#category : #'Bloc-Demo-NodeTests'
 }
 
 { #category : #tests }
 BlDemoBasicNodeTest >> testEnsureClassForWithDifferentClass [
 
-	| demo |
+	| demo class class2 |
 	demo := BlDemoCollector new.
-	class := demo ensureClassFor: BlDemoData.
-	class2 := demo ensureClassFor: BlDemoData2.
-	self deny: class == class2
+	class := demo ensureClassFor: BlFakeDemo.
+	class2 := demo ensureClassFor: BlFakeDemo2.
+
+	self deny: class identicalTo: class2
 ]
 
 { #category : #tests }
 BlDemoBasicNodeTest >> testEnsureClassForWithSameClass [
 
-	| demo |
+	| demo class class2 |
 	demo := BlDemoCollector new.
-	class := demo ensureClassFor: BlDemoData.
-	class2 := demo ensureClassFor: BlDemoData.
-	self assert: class == class2
+	class := demo ensureClassFor: BlFakeDemo.
+	class2 := demo ensureClassFor: BlFakeDemo.
+
+	self assert: class identicalTo: class2
 ]
 
 { #category : #tests }
@@ -35,7 +33,8 @@ BlDemoBasicNodeTest >> testEnsurePackageForWithSamePackage [
 	demo := BlDemoCollector new.
 	package := demo ensurePackageFor: 'Bloc-Demo'.
 	package2 := demo ensurePackageFor: 'Bloc-Demo'.
-	self assert: package == package2
+
+	self assert: package identicalTo: package2
 ]
 
 { #category : #tests }
@@ -44,8 +43,8 @@ BlDemoBasicNodeTest >> testOneClassWithDifferentPragma [
 	| collector elt1 classNode |
 
 	collector := BlDemoCollector new.
-	collector pragma: #demo2.
-	collector collectClass: BlDemoData.
+	collector pragma: #demoTestingPragma2.
+	collector collectClass: BlFakeDemo.
 	classNode := collector classes first.
 	elt1 := classNode children first.
 	self assert: elt1 class equals: BlDemoMethodNode.
@@ -57,12 +56,14 @@ BlDemoBasicNodeTest >> testOneClassWithDifferentPragma [
 BlDemoBasicNodeTest >> testOneClassWithTwoMethodsHasTwoNodes [
 
 	| collector elt1 elt2 classNode |
-	
 	collector := BlDemoCollector new.
-	collector collectClass: BlDemoData.
+	collector pragma: #demoTestingPragma.
+	collector collectClass: BlFakeDemo.
 	classNode := collector classes first.
+
 	elt1 := classNode children first.
 	self assert: elt1 class equals: BlDemoMethodNode.
+
 	elt2 := classNode children second.
 	self assert: elt2 class equals: BlDemoMethodNode.
 
@@ -73,25 +74,25 @@ BlDemoBasicNodeTest >> testOneClassWithTwoMethodsHasTwoNodes [
 { #category : #tests }
 BlDemoBasicNodeTest >> testOneClassWithoutPragma [
 
-	| collector  |
-	
+	| collector |
 	collector := BlDemoCollector new.
-	collector pragma: #blabla.
-	collector collectClass: BlDemoData.
+	collector pragma: #demoTestingPragma_Empty.
+	collector collectClass: BlFakeDemo.
+
 	self assert: collector classes isEmpty
 ]
 
 { #category : #tests }
 BlDemoBasicNodeTest >> testOnePackageWithTwoClassesHasTwoNodes [
 
 	| collector packages |
-	collector := BlDemoCollector new
-		             pragma: #demo;
-		             collectPackage:
-			             (self class packageOrganizer packageNamed: #'Bloc-Demo').
+	collector := BlDemoCollector new.
+	collector
+		pragma: #demoTestingPragma;
+		collectPackageNamed: #'Bloc-Demo'.
+
 	packages := collector packages.
 	self assert: packages size equals: 1.
-
 	self assert: packages first class equals: BlDemoPackageNode.
 	self assert: packages first children size equals: 2.
 	self
@@ -103,13 +104,14 @@ BlDemoBasicNodeTest >> testOnePackageWithTwoClassesHasTwoNodes [
 BlDemoBasicNodeTest >> testOnePackageWithTwoClassesHasTwoNodesWithSample2 [
 
 	| collector packages |
-	collector := BlDemoCollector new
-		             pragma: #demo2;
-		             collectPackage:
-			             (self class packageOrganizer packageNamed: #'Bloc-Demo').
+	collector := BlDemoCollector new.
+	collector
+		pragma: #demoTestingPragma2;
+		collectPackage:
+			(self class packageOrganizer packageNamed: #'Bloc-Demo').
+
 	packages := collector packages.
 	self assert: packages size equals: 1.
-
 	self assert: packages first class equals: BlDemoPackageNode.
 	self assert: packages first children size equals: 1
 ]

src/Bloc-Demo/BlDemoClassNode.class.st

@@ -1,3 +1,6 @@
+"
+I'm a demo node for a class.
+"
 Class {
 	#name : #BlDemoClassNode,
 	#superclass : #BlDemoBasicNode,
@@ -11,6 +14,7 @@ BlDemoClassNode >> icon [
 ]
 
 { #category : #accessing }
-BlDemoClassNode >> methods [ 
+BlDemoClassNode >> methods [
+
 	^ item methods
 ]

src/Bloc-Demo/BlDemoCollector.class.st

@@ -1,3 +1,6 @@
+"
+I'm responsible of collecting demo nodes from a given pragma.
+"
 Class {
 	#name : #BlDemoCollector,
 	#superclass : #Object,
@@ -9,83 +12,50 @@ Class {
 	#category : #'Bloc-Demo-DemoPresenterNodes'
 }
 
-{ #category : #'instance creation' }
-BlDemoCollector class >> collectClass: aClass [
-
-	^ self new collectClass: aClass
-]
-
-{ #category : #'instance creation' }
-BlDemoCollector class >> collectPackage: aPackage [
-
-	^ self new collectPackage: aPackage
-]
-
-{ #category : #'instance creation' }
-BlDemoCollector class >> collectPragma: aSymbol fromClass: aClass [
-
-	^ self new
-		  pragma: aSymbol;
-		  collectClass: aClass 
-]
-
-{ #category : #'instance creation' }
-BlDemoCollector class >> collectPragma: aSymbol fromPackage: aPackage [
-
-	^ self new 
-		pragma: aSymbol; 
-		collectPackage: aPackage 
-]
-
 { #category : #accessing }
 BlDemoCollector >> classes [
+
 	^ classDictionary values
 ]
 
 { #category : #instanceCreation }
 BlDemoCollector >> collectClass: aClass [ 
 
 	| node pragmas |
-	pragmas := (Pragma allNamed: pragma in: aClass) sorted: [ :pragma1 :pragma2 |
-		pragma1 methodSelector < pragma2 methodSelector ].
+	pragmas := (Pragma allNamed: pragma in: aClass)
+		sorted: [ :pragma1 :pragma2 |
+			pragma1 methodSelector < pragma2 methodSelector ].
+
 	pragmas ifEmpty: [ ^ self ].
 	node := self ensureClassFor: aClass.
-	pragmas do: [ :prag | node addChild: (BlDemoMethodNode new item: prag method ) ].
-	
-	
+	pragmas do: [ :each |
+		node addChild: (BlDemoMethodNode withItem: each method) ]
 ]
 
 { #category : #instanceCreation }
 BlDemoCollector >> collectPackage: aPackage [
 
-	"| packageClasses packageNode classes |
-	packageClasses := (aPackage classes flatCollect: [ :class | { class. class class } ])
-		sorted: [ :class1 :class2 | class1 name < class2 name ].
-	packageNode := self ensurePackageFor: aPackage.
-	classes := OrderedCollection new.
-	packageClasses do: [ :pairclass |
-		| aNode |
-		self collectClass: pairclass.
-		aNode := classDictionary at: pairclass ifAbsent: [ nil ].
-		aNode ifNotNil: [ packageNode addChild: aNode ] ]."
-
-
 	| packageClasses node classes |
-	packageClasses := (aPackage classes flatCollect: [ :class | { class. class class } ])
+	packageClasses := (aPackage definedClasses
+		flatCollect: [ :class | { class. class class } ])
 		sorted: [ :class1 :class2 | class1 name < class2 name ].
 	classes := OrderedCollection new.
 	packageClasses do: [ :class |
-		| temp |
 		self collectClass: class.
-		temp := classDictionary at: class ifAbsent: [  ].
-		temp ifNotNil: [ classes add: temp ] ].
+		classDictionary at: class ifPresent: [ :c | classes add: c ] ].
 	classes ifEmpty: [ ^ self ].
 	node := self ensurePackageFor: aPackage.
 	classes do: [ :classNode | node addChild: classNode ]
 
 
 ]
 
+{ #category : #'as yet unclassified' }
+BlDemoCollector >> collectPackageNamed: aString [
+
+	self collectPackage: (self class packageOrganizer packageNamed: aString)
+]
+
 { #category : #collection }
 BlDemoCollector >> collectPackages: anOrderedCollection [
 
@@ -98,15 +68,15 @@ BlDemoCollector >> ensureClassFor: aClass [
 
 	^ classDictionary 
 		at: aClass 
-		ifAbsentPut: [BlDemoClassNode new item: aClass; yourself]
+		ifAbsentPut: [ BlDemoClassNode withItem: aClass ]
 ]
 
 { #category : #collection }
 BlDemoCollector >> ensurePackageFor: aPackage [ 
 
 	^ packageDictionary 
 		at: aPackage 
-		ifAbsentPut: [ BlDemoPackageNode new item: aPackage; yourself]
+		ifAbsentPut: [ BlDemoPackageNode withItem: aPackage ]
 ]
 
 { #category : #initialization }
@@ -125,6 +95,7 @@ BlDemoCollector >> packages [
 ]
 
 { #category : #accessing }
-BlDemoCollector >> pragma: aString [ 
+BlDemoCollector >> pragma: aString [
+
 	pragma := aString
 ]