'***Patrick Rutledge, 9/98 
'This script copies the operations of an interface to the classes which 
'realize it.  It operates on selected classes, but could be changed to 
'work on all classes.  It can be used to update a class after an op is 
'added to an interface, but it won't update an existing op in the 
'realizing class. 
'ops are equal if they have same name and parameters 
Function OpsEqual (inOp1 As Operation, inOp2 As Operation) As Boolean 
 OpsEqual = False 
 Dim param1 As parameter 
 Dim param2 As Parameter 
 If inOp1.name = inOp2.name Then 
  If inOp1.Parameters.Count = inOp1.Parameters.Count Then 
   For i% = 1 To inOp1.Parameters.Count 
    Set param1 = inOp1.Parameters.GetAt(i%) 
    Set param2 = inOp2.Parameters.Getat(i%) 
    If param1.name <> param2.name Or _ 
       param1.type <> param2.type Then 
         Exit Function 
    End If 
   Next i% 
  OpsEqual = True 
  End If 
 End If 
End Function 

'returns true if an op equals to inOp exists in inOps 
Function OpExists (inOps As OperationCollection, inOp As Operation) As Boolean 
 OpExists = False 
 Dim op As Operation 
 For i% = 1 To inOps.Count 
  Set op = inOps.GetAt(i%) 
  If OpsEqual (op, inOp) Then 
   OpExists = True 
   Exit Function 
     End If 
 Next i% 
End Function 

Sub CloneOperation (inClass As Class, inOp As Operation) 
 Dim cloneOp As Operation 
 Dim param As Parameter 

 Set cloneOp = inClass.AddOperation (inOp.name, inOp.ReturnType) 

 cloneOp.Virtual = inOp.Virtual 
 cloneOp.Preconditions = inOp.Preconditions 
 cloneOp.Semantics = inOp.Semantics 
 cloneOp.Postconditions = inOp.Postconditions 
 cloneOp.Protocol = inOp.Protocol 
 cloneOp.Qualification = inOp.Qualification 
 cloneOp.Exceptions = inOp.Exceptions 
 cloneOp.Time = inOp.Time 
 cloneOp.Size = inOp.Size 
 cloneOp.ExportControl = inOp.ExportControl 
  
 For j% = 1 To inOp.Parameters.Count 
  Set param = inOp.Parameters.GetAt(j%) 
  Set x = cloneOp.AddParameter (param.name, param.Type, param.InitValue, j%) 
 Next j% 
End Sub 

'copies any methods of realized interace to client - returns true if did something 
Function RealizeOps (inRealize As RealizeRelation) As Boolean 
 Dim client As Class 
 Dim supplier As Class 
 Dim op As Operation 
 RealizeOps = False 

 Set client = inRealize.GetContextClass() 
 Set supplier = inRealize.GetSupplierClass() 

 For i% = 1 To supplier.Operations.Count 
  Set op = supplier.Operations.GetAt(i%) 
  If Not OpExists (client.Operations, op) Then 
   CloneOperation client, op 
   RealizeOps = True 
  End If 
 Next i% 
End Function 

Sub Main 
 Dim classes As ClassCollection 
 Dim aClass As Class 
 Dim realizes As RealizeRelationCollection 
 Dim aRealize As RealizeRelation 
 numEdited% = 0 

 Set classes = RoseApp.CurrentModel.GetSelectedClasses() 
 If classes.Count = 0 Then 
  MsgBox "No classes selected" 
  Exit Sub 
 End If 

 For i% = 1 To classes.Count 
  Set aClass = classes.GetAt(i%) 
  Set realizes = aClass.GetRealizeRelations() 
  For j% = 1 To realizes.Count 
   Set aRealize = realizes.GetAt(j%) 
   If RealizeOps (aRealize) Then 
    numEdited% = numEdited% + 1 
   End If 
  Next j% 
 Next i% 
  
 MsgBox  "Updated " & numEdited% & " classes" 
End Sub