'
' === Draws subsystem interfaces ===
'
' Version: 1.01
' Author: Michael Moors (mmoors@rational.com)
' Copyright 2000 - Rational Software Corporation
'
' Usage:
' Compile the script and put it in a menu
' Open a diagram, select a package and execute the script.
'
' Tested:
' Compiled and debug version (see 'DEBUG lines)
' 
' Not tested: 
' - Multiple packages / subsystem
'
' Known limitations:
' - There still is no icon for the new sterotype <<Subsystem Proxy>>
' - The script does not work if a class with the same name already exists
' - The script does not check for the <<subsystem>> Stereotype
'

Sub Main

 'RoseApp.Currentmodel.rootcategory.classdiagrams.getat(1).activate 'DEBUG
 'RoseApp.Currentmodel.rootcategory.classdiagrams.getat(1).itemviews.getat(1).setselected true'DEBUG

 Dim proxy As class
 Dim cls As class
 Dim cat As category
 Dim diag As Diagram
 Dim classdiag As ClassDiagram
 Dim cats As CategoryCollection
 Dim pubs As ClassCollection
 Dim x As Long
 Dim y As Long

 Set diag = roseapp.currentmodel.getactivediagram 
 If diag Is Nothing Then 
  Msgbox "Open a Class Diagram before executing."
 Else 
 If Not diag.cantypecast(ClassDiag) Then 
  Msgbox "Sorry, only supported on Class Diagrams."
  Exit Sub
 Else
  Set classdiag = diag.typecast(ClassDiag)
  Set cats = classdiag.Getselectedcategories
  If cats.count = 0 Then
   Msgbox "Select the package for which to generate subsystem interfaces"
  Else
   For x = 1 To cats.count
    Set cat = cats.getat(x)
    If cat.classes.findfirst(cat.name) <> 0 Then
     MsgBox "There is already a class with the name of the package."
    Else 
     Set proxy = cat.addclass(cat.name)
     proxy.exportcontrol = "PublicAccess"
     proxy.stereotype = "Subsystem Proxy"
     Set pubs = cat.classes
     For y = 1 To pubs.count
      Set cls = pubs.getat(y)
      If cls.exportcontrol = "PublicAccess" Then
 	   Set rel = proxy.addrealizerel("",cls.name)
       dummy = classdiag.addclass(cls)
      End If
     Next y
    End If
   Next x
  End If
 End If
 End If
End Sub