Merge pull request #585 from carolahp/feature/scopesBrowser

Creates Scopes Editor

src/BaselineOfNewTools/BaselineOfNewTools.class.st

@@ -81,7 +81,14 @@ BaselineOfNewTools >> baseline: spec [
 			package: 'NewTools-RewriterTools-Backend';
 			package: 'NewTools-RewriterTools' with: [ spec requires: #('NewTools-RewriterTools-Backend') ];
 			package: 'NewTools-RewriterTools-Backend-Tests' with: [ spec requires: #('NewTools-RewriterTools-Backend') ];
-			package: 'NewTools-RewriterTools-Tests' with: [ spec requires: #('NewTools-RewriterTools') ].
+			package: 'NewTools-RewriterTools-Tests' with: [ spec requires: #('NewTools-RewriterTools') ];
+			"Scopes Editor"
+			package: 'NewTools-Scopes';
+			package: 'NewTools-Scopes-Editor' with: [ spec requires: #('NewTools-Scopes') ];
+			package: 'NewTools-Scopes-Tests';
+			package: 'NewTools-Scopes-Resources-A-Tests';
+			package: 'NewTools-Scopes-Resources-B-Tests';
+			package: 'NewTools-Scopes-Resources-C-Tests'.
 
 		spec
 			group: 'Core' with: #( 'NewTools-Core' 'NewTools-Morphic' );
@@ -130,6 +137,14 @@ BaselineOfNewTools >> baseline: spec [
 				    		'NewTools-RewriterTools'
 				    		'NewTools-RewriterTools-Backend-Tests'
 				    		'NewTools-RewriterTools-Tests' );
+			"ScopesEditor"
+			group: #ScopesEditor with: #(
+						'NewTools-Scopes' 
+						'NewTools-Scopes-Editor' 
+						'NewTools-Scopes-Resources-A-Tests' 
+						'NewTools-Scopes-Resources-B-Tests' 
+						'NewTools-Scopes-Resources-C-Tests' 
+						'NewTools-Scopes-Tests');
 			group: 'default' with: #( 
 						'Playground' 
 						'Inspector' 
@@ -139,7 +154,8 @@ BaselineOfNewTools >> baseline: spec [
 						'FontChooser' 
 						'Methods'
 				   		'Spotter'
-            					'RewriterTools') ]
+            					'RewriterTools'
+						'ScopesEditor') ]
 ]
 
 { #category : 'external projects' }

src/NewTools-CodeCritiques/RPackage.extension.st → src/NewTools-CodeCritiques/Package.extension.st

@@ -1,7 +1,7 @@
-Extension { #name : 'RPackage' }
+Extension { #name : 'Package' }
 
 { #category : '*NewTools-CodeCritiques' }
-RPackage >> criticNameOn: aStream [
+Package >> criticNameOn: aStream [
 	"This behavior may be folded later by changing the name of this method or using another one."
 
 	aStream << self packageName

src/NewTools-Scopes-Editor/Package.extension.st

@@ -0,0 +1,6 @@
+Extension { #name : 'Package' }
+
+{ #category : '*NewTools-Scopes-Editor' }
+Package >> scopesIconName [
+	^ #package
+]

src/NewTools-Scopes-Editor/ScopeAbstractPresenter.class.st

@@ -0,0 +1,77 @@
+"
+I allow to easily create trees (instances of ScopeTreePresenter) to display scopes (as roots) and scopes (as roots)
+"
+Class {
+	#name : 'ScopeAbstractPresenter',
+	#superclass : 'SpPresenter',
+	#instVars : [
+		'model'
+	],
+	#category : 'NewTools-Scopes-Editor-GUI',
+	#package : 'NewTools-Scopes-Editor',
+	#tag : 'GUI'
+}
+
+{ #category : 'accessing' }
+ScopeAbstractPresenter >> announcer [ 
+	^ model announcer
+]
+
+{ #category : 'actions' }
+ScopeAbstractPresenter >> getNameFromUser [
+
+	^ (ScopeRequestLabel newApplication: self application)
+		  title: 'Scope name...';
+		  validateAnswer: [ :txt |
+			  | isValid |
+			  isValid := self validateNameBlock value: txt.
+			  isValid ifFalse: [
+					  isValid ifFalse: [
+							  self inform: 'Name can''t be empty or contain spaces' ] ].
+			  isValid ];
+		  onAccept: [ :dialog | dialog close ];
+		  extent: 250 @ 150;
+		  openModal
+]
+
+{ #category : 'private - presenters' }
+ScopeAbstractPresenter >> newScopeTree [
+
+	^ self instantiate: ScopeTreePresenter
+]
+
+{ #category : 'private - presenters' }
+ScopeAbstractPresenter >> setModelBeforeInitialization: aScopesManager [
+
+	model := aScopesManager 
+]
+
+{ #category : 'menu commands' }
+ScopeAbstractPresenter >> showReferencesToClass: aClass [
+
+	| scope browser query class |
+	class := aClass.
+	scope := ClySystemEnvironmentScope
+		         of: ClySystemEnvironment currentImage
+		         in: ClyNavigationEnvironment currentImage.
+
+	browser := (ClyFullBrowserMorph on:
+		            ClyNavigationEnvironment currentImage)
+		           ensureInitialState.
+
+	query := (ClyClassReferencesQuery of: class)
+		         scope: scope;
+		         yourself.
+
+	browser spawnQueryBrowserOn: query
+]
+
+{ #category : 'private' }
+ScopeAbstractPresenter >> validateNameBlock [
+
+	^ [ :txt |
+	  | isValid |
+	  isValid := txt isNotNil and: [
+		             txt isNotEmpty and: [ (txt includesSubstring: ' ') not ] ].
+	  isValid ]
+]

src/NewTools-Scopes-Editor/ScopeClassNode.class.st

@@ -0,0 +1,37 @@
+"
+I am wrapper for classes to be used in the ScopeNodesTree
+"
+Class {
+	#name : 'ScopeClassNode',
+	#superclass : 'ScopeNode',
+	#category : 'NewTools-Scopes-Editor-Nodes',
+	#package : 'NewTools-Scopes-Editor',
+	#tag : 'Nodes'
+}
+
+{ #category : 'accessing' }
+ScopeClassNode >> children [
+
+	^  #(  )
+]
+
+{ #category : 'testing' }
+ScopeClassNode >> isClassNode [
+	^ true
+]
+
+{ #category : 'accessing' }
+ScopeClassNode >> isClassOrTraitNode [
+	^ true
+]
+
+{ #category : 'accessing' }
+ScopeClassNode >> packageNode [
+
+	^ ScopePackageNode on: self package
+]
+
+{ #category : 'accessing' }
+ScopeClassNode >> scopesIconName [
+	^ #class
+]

src/NewTools-Scopes-Editor/ScopeNode.class.st

@@ -0,0 +1,145 @@
+"
+I am an abstract wrapper for classes, packages and traits to be used in the ScopeNodesTree
+"
+Class {
+	#name : 'ScopeNode',
+	#superclass : 'Object',
+	#instVars : [
+		'value'
+	],
+	#category : 'NewTools-Scopes-Editor-Nodes',
+	#package : 'NewTools-Scopes-Editor',
+	#tag : 'Nodes'
+}
+
+{ #category : 'instance creation' }
+ScopeNode class >> on: aRBEnvironment [
+
+	self class == ScopeNode ifTrue: [
+		self error: 'I am an abstract class' ].
+
+	^ self new
+		  value: aRBEnvironment;
+		  yourself
+]
+
+{ #category : 'operations' }
+ScopeNode >> & anotherNode [
+
+	^ ScopesManager newScopeFrom: self value and: anotherNode value
+]
+
+{ #category : 'comparing' }
+ScopeNode >> <= aNode [
+	^ self label <= aNode label
+]
+
+{ #category : 'comparing' }
+ScopeNode >> = anotherNode [
+
+	^ (self class = anotherNode class)
+		and: [ self label = anotherNode label ]
+]
+
+{ #category : 'comparing' }
+ScopeNode >> == anotherNode [
+
+	^ self = anotherNode
+]
+
+{ #category : 'accessing' }
+ScopeNode >> basicEqualsTo: aNode [
+
+	^ self value = aNode value
+]
+
+{ #category : 'accessing' }
+ScopeNode >> children [
+	self subclassResponsibility 
+]
+
+{ #category : 'accessing' }
+ScopeNode >> definedClasses [
+	^#()
+]
+
+{ #category : 'comparing' }
+ScopeNode >> hash [
+	^ value hash
+]
+
+{ #category : 'testing' }
+ScopeNode >> isClassNode [
+	^ false
+]
+
+{ #category : 'testing' }
+ScopeNode >> isClassOrTraitNode [
+	^ false
+]
+
+{ #category : 'testing' }
+ScopeNode >> isPackageNode [
+	^ false
+]
+
+{ #category : 'testing' }
+ScopeNode >> isScopeNode [
+	^ false
+]
+
+{ #category : 'accessing' }
+ScopeNode >> label [
+
+	^ self value name , ' [package: ' , self value package name , ']'
+]
+
+{ #category : 'accessing' }
+ScopeNode >> name [
+	^ value name
+]
+
+{ #category : 'operations' }
+ScopeNode >> not [
+
+	^ ScopesManager newScopeFromNot: self value
+]
+
+{ #category : 'accessing' }
+ScopeNode >> package [
+	^ value package
+]
+
+{ #category : 'accessing' }
+ScopeNode >> packageNode [
+	self subclassResponsibility 
+]
+
+{ #category : 'accessing' }
+ScopeNode >> printOn: aStream [
+
+	aStream
+		nextPutAll: self class name , '(' , self label;
+		nextPutAll: ')'
+]
+
+{ #category : 'accessing' }
+ScopeNode >> scopesIconName [
+	self subclassResponsibility
+]
+
+{ #category : 'accessing' }
+ScopeNode >> value [
+	^ value
+]
+
+{ #category : 'accessing' }
+ScopeNode >> value: aPackageOrClass [
+	value := aPackageOrClass
+]
+
+{ #category : 'operations' }
+ScopeNode >> | anotherNode [
+
+	^ self value | anotherNode value
+]