use tree layout if dominance tree fails

repository/OpenPonk-Core/OPProjectController.class.st

@@ -168,25 +168,28 @@ OPProjectController >> mergeFromFile [
 OPProjectController >> mergeModelsAndDiagramsIntoOne [
 
 	| showError plugins models plugin |
-	showError := [ :text | 
+	showError := [ :text |
 	             ^ (GrowlMorph
 		                label: 'Unable to merge models'
 		                contents: text)
 		               backgroundColor:
 			               GrowlMorph theme dangerBackgroundColor;
+		               labelColor: GrowlMorph theme textColor;
+		               textColor:
+			               GrowlMorph theme textColorForNonStandardBackground;
 		               openInWorld ].
 	models := self project models.
 	models ifEmpty: [ ^ showError value: 'There are no models' ].
-	(self project diagrams size < 2 and: [ models size < 2 ]) ifTrue: [ 
+	(self project diagrams size < 2 and: [ models size < 2 ]) ifTrue: [
 		^ showError value:
 			  'The model is as merged as it can be - there have to be at least 2 models or 2 diagrams' ].
-	plugins := models collect: [ :each | 
+	plugins := models collect: [ :each |
 		           OPPluginRegistry default pluginFor: each ].
-	plugins asSet size = 1 ifFalse: [ 
+	plugins asSet size = 1 ifFalse: [
 		^ showError value:
 			  'All models must be of the same type/metamodel/plugin' ].
 	plugin := plugins anyOne.
-	plugin supportsMergingModels ifFalse: [ 
+	plugin supportsMergingModels ifFalse: [
 		^ showError value: 'Plugin of these models does not support merging' ].
 
 	SpConfirmDialog new
@@ -195,10 +198,10 @@ OPProjectController >> mergeModelsAndDiagramsIntoOne [
 			'This is irreversible and original models and diagrams will be lost.';
 		acceptLabel: 'Yes, merge them';
 		cancelLabel: 'Cancel';
-		onAccept: [ 
+		onAccept: [
 			| model diagram layouter |
 			model := plugin mergeModels: models.
-			self project diagrams do: [ :eachDiagram | 
+			self project diagrams do: [ :eachDiagram |
 					workbench closeEditorOfDiagram: eachDiagram ].
 			models do: [ :eachModel | self removeModel: eachModel ].
 			diagram := OPOpenPonkDiagram forModelElement: model.

repository/OpenPonk-Spec/OPLayoutLoopDetector.class.st

@@ -0,0 +1,102 @@
+Class {
+	#name : #OPLayoutLoopDetector,
+	#superclass : #Object,
+	#instVars : [
+		'boxes',
+		'links',
+		'processedBoxes'
+	],
+	#category : #'OpenPonk-Spec-Layouting'
+}
+
+{ #category : #actions }
+OPLayoutLoopDetector class >> haveLoopsBoxes: boxes links: links [
+
+	^ self new
+		  boxes: boxes;
+		  links: links;
+		  haveLoops
+]
+
+{ #category : #actions }
+OPLayoutLoopDetector class >> popupHaveLoopsBoxes: boxes links: links [
+
+	^ self new
+		  boxes: boxes;
+		  links: links;
+		  popupHaveLoops
+]
+
+{ #category : #accessing }
+OPLayoutLoopDetector >> boxes [
+
+	^ boxes
+]
+
+{ #category : #accessing }
+OPLayoutLoopDetector >> boxes: anObject [
+
+	boxes := Array withAll: anObject
+]
+
+{ #category : #'as yet unclassified' }
+OPLayoutLoopDetector >> hasBox: box loopsBackTo: loopsTo [
+
+	| toBoxes |
+	(processedBoxes includes: box) ifTrue: [ ^ false ].
+
+	toBoxes := (links
+		            select: [ :each | each from = box ]
+		            thenCollect: [ :each | each to ]) intersection: boxes.
+
+	processedBoxes add: box.
+
+	^ toBoxes anySatisfy: [ :any |
+		  (loopsTo includes: any) or: [
+			  self hasBox: any loopsBackTo: loopsTo , { box } ] ]
+]
+
+{ #category : #'as yet unclassified' }
+OPLayoutLoopDetector >> haveLoops [
+
+	^ boxes anySatisfy: [ :box | self hasBox: box loopsBackTo: Set new ]
+]
+
+{ #category : #initialization }
+OPLayoutLoopDetector >> initialize [
+
+	super initialize.
+
+	links := Set new.
+	boxes := Array new.
+	processedBoxes := Set new
+]
+
+{ #category : #accessing }
+OPLayoutLoopDetector >> links [
+
+	^ links
+]
+
+{ #category : #accessing }
+OPLayoutLoopDetector >> links: anObject [
+
+	links addAll: anObject
+]
+
+{ #category : #'as yet unclassified' }
+OPLayoutLoopDetector >> popupHaveLoops [
+
+	^ self haveLoops
+		  ifTrue: [
+			  (GrowlMorph
+				   label: 'Unable to use dominance tree layout'
+				   contents:
+					   'Unable to use dominance tree layout as the diagram contains loops. Trying tree layout...')
+				  backgroundColor: GrowlMorph theme warningBackgroundColor;
+				  labelColor: GrowlMorph theme textColor;
+				  textColor: GrowlMorph theme textColorForNonStandardBackground;
+				  openInWorld.
+			  ^ true ]
+		  ifFalse: [ false ]
+]

repository/OpenPonk-Spec/OPLayouter.class.st

@@ -85,7 +85,9 @@ OPLayouter >> diagramController: aDiagramController [
 { #category : #layouts }
 OPLayouter >> dominanceTreeLayout [
 
-	self applyLayout: [ :boxes :links | 
+	self applyLayout: [ :boxes :links |
+		(OPLayoutLoopDetector popupHaveLoopsBoxes: boxes links: links)
+			ifTrue: [ ^ self treeLayout ].
 		RSDominanceTreeLayout new
 			verticallyReverse;
 			verticalGap: 100;

repository/OpenPonk-Spec/OPProjectNewModelCommand.class.st

@@ -23,13 +23,12 @@ OPProjectNewModelCommand >> defaultMenuItemName [
 { #category : #execution }
 OPProjectNewModelCommand >> execute [
 
-	OPPluginRegistry default plugins ifEmpty: [ 
+	OPPluginRegistry default plugins ifEmpty: [
 		^ GrowlMorph
 			  openWithLabel: 'OpenPonk: No plugins'
 			  contents:
 			  'Cannot add a model unless there is at least one OpenPonk plugin loaded'
-			  backgroundColor: GrowlMorph theme warningBackgroundColor
-			  labelColor: GrowlMorph theme textColor ].
+			  backgroundColor: GrowlMorph theme dangerBackgroundColor ].
 	(OPModelTypeSelector
 		 newApplication: SpApplication defaultApplication
 		 model: projectController) open