Unit Groups;

  { Windows that are specific to one stock use groups to manage that stock.
    Each window has a group.  All windows in the same group use the same stock
    symbol.  To change the stock symbol in a window, change the stock symbol
    of that window's group.

    Groups are always referenced by the group name.  Group names are case
    sensitive and can contain spaces and other special characters.  The
    empty sting is a special case.  That group is never associated with a
    stock symbol.  It is usally used to indicate that a window does not have
    a group.

    This unit is not thread safe.  It should only be accessed from the GUI
    thread.
  }

Interface

  Uses
    Classes;

  Type
    { When the symbol of a group changes, each member of the group gets
      this callback. }
    TGroupChanged = Procedure(NewSymbol : String) Of Object;

    { This class is how the outside world makes use of groups. }
    TGroupList =
      Class(TObject)
      Private
        Groups : TStrings;
        LastGroup : Cardinal;
      Protected
      Public
        Destructor Destroy; Override;

        { This requests callbacks for the group.  Any time the symbol for the
          given group changes, the given callback will be called.  If the user
          is the only member of the group, the symbol for the group will
          be changed to CurrentSymbol.  Otherwise, the user will immediately
          get a callback telling him the symbol already assigned to the gorup.
          Key is used by RemoveFromGroup.  It can be any object. }
        Procedure AddToGroup(Group : String; Key : TObject; Callback : TGroupChanged; CurrentSymbol : String = '');

        { This removes the user from the group.  Group and Key should be the
          same as were provided to AddToGroup.  After calling this, the user
          will not recieve any future callbacks. }
        Procedure RemoveFromGroup(Group : String; Key : TObject);

        { This changes the symbol associated with the group.  We automatically
          notify all members of the group when this changes. }
        Procedure SetSymbol(Group, Symbol : String);

        { This returns the current symbol for the group.  Once a group goes
          away, we no longer remember the symbol associated with the group. }
        Function GetSymbol(Group : String) : String;

        { This generates a unique group name. }
        Function NewGroup : String;

        { This is a list of the names of all groups.  As soon as the last
          member of a group goes away, the group goes away.  At that time
          it will be removed from this list.

          The result of this list should be read only.  For performance
          reasons, and for simplicity, the user gets access to a list used
          internally.  Do not modify this list. }
        Property GroupNames : TStrings Read Groups;

        { Most users use Instance to get a pointer to the primary group list.
          Usually this is the only group list.  However, there can be
          multiple group lists, if the need should arise. }
        Class Function Instance : TGroupList;
        Constructor Create;
      End;

Implementation

  Uses
    Contnrs,
    SysUtils;

  ////////////////////////////////////////////////////////////////////////
  // TGroup
  ////////////////////////////////////////////////////////////////////////

  Type
    TGroup =
      Class(TObject)
      Private
        Name : String;
        Symbol : String;
        Items : TStringList;
        Class Function KeyToString(Key : TObject) : String;
      Public
        Constructor Create(Name : String);
        Destructor Destroy; Override;
        Procedure AddToGroup(Key : TObject; Callback : TGroupChanged; CurrentSymbol : String);
        Procedure RemoveFromGroup(Key : TObject);
        Procedure SetSymbol(Symbol : String);
        Function GetSymbol : String;
        Function Empty : Boolean;
      End;

    TGroupChangedHolder =
      Class(TObject)
        GC : TGroupChanged;
      End;

  Class Function TGroup.KeyToString(Key : TObject) : String;
    Begin
      Result := Format('%s : %x', [Key.ClassName, Integer(Pointer(Key))])
    End;

  Constructor TGroup.Create(Name : String);
    Begin
      Self.Name := Name;
      Items := TStringList.Create;
      Items.Sorted := True;
      Items.CaseSensitive := True
    End;

  Procedure TGroup.AddToGroup(Key : TObject; Callback : TGroupChanged; CurrentSymbol : String);
    Var
      Holder : TGroupChangedHolder;
    Begin
      Holder := TGroupChangedHolder.Create;
      Holder.GC := Callback;
      Items.AddObject(KeyToString(Key), Holder);
      If (Items.Count = 1) Or (Symbol = '') Then
        SetSymbol(CurrentSymbol)
      Else
        Callback(Symbol)
    End;

  Procedure TGroup.RemoveFromGroup(Key : TObject);
    Var
      Index : Integer;
    Begin
      Index := Items.IndexOf(KeyToString(Key));
      If Index >= 0 Then
        Begin
          Items.Objects[Index].Free;
          Items.Delete(Index)
        End
    End;

  Procedure TGroup.SetSymbol(Symbol : String);
    Var
      Index : Integer;
    Begin
      Symbol := Trim(UpperCase(Symbol));
      Self.Symbol := Symbol;  // We have to set the symbol here, before we tell all of the
                              // listeners, or the listeners might get confused.  The
                              // execution panel, in particular, will see an inconsistancy.  
      For Index := 0 To Pred(Items.Count) Do
        (TObject(Items.Objects[Index]) As TGroupChangedHolder).GC(Symbol)
    End;

  Function TGroup.GetSymbol : String;
    Begin
      Result := Symbol
    End;

  Function TGroup.Empty : Boolean;
    Begin
      Result := Items.Count = 0
    End;

  Destructor TGroup.Destroy;
    Var
      Index : Integer;
    Begin
      For Index := 0 To Pred(Items.Count) Do
        TObject(Items.Objects[Index]).Free;
      Items.Free
    End;

  ////////////////////////////////////////////////////////////////////////
  // TGroupList
  ////////////////////////////////////////////////////////////////////////

  ThreadVar
    InCorrectThread : Boolean;

  Function GetGroup(List : TGroupList; Name : String) : TGroup;
    Var
      Index : Integer;
    Begin
      Index := List.Groups.IndexOf(Name);
      If Index = -1 Then
        Result := Nil
      Else
        Result := TGroup(List.Groups.Objects[Index])
    End;

  Constructor TGroupList.Create;
    Begin
      Groups := TStringList.Create;
      (Groups As TStringList).Sorted := True;
      (Groups As TStringList).CaseSensitive := True
    End;

  Destructor TGroupList.Destroy;
    Begin
      Groups.Free
    End;

  Procedure TGroupList.AddToGroup(Group : String; Key : TObject; Callback : TGroupChanged; CurrentSymbol : String = '');
    Var
      G : TGroup;
    Begin
      Assert(InCorrectThread, 'TGroupList.AddToGroup called from wrong thread.');
      If Group = '' Then Exit;
      G := GetGroup(Self, Group);
      If Not Assigned(G) Then
        Begin
          G := TGroup.Create(Group);
          Groups.AddObject(Group, G)
        End;
      G.AddToGroup(Key, Callback, CurrentSymbol)
    End;

  Procedure TGroupList.RemoveFromGroup(Group : String; Key : TObject);
    Var
      Index : Integer;
      G : TGroup;
    Begin
      Assert(InCorrectThread, 'TGroupList.RemoveFromGroup called from wrong thread.');
      If Group = '' Then Exit;
      Index := Groups.IndexOf(Group);
      If Index >= 0 Then
        Begin
          G := Groups.Objects[Index] As TGroup;
          G.RemoveFromGroup(Key);
          If G.Empty Then
            Begin
              Groups.Delete(Index);
              G.Free
            End
        End
    End;

  Procedure TGroupList.SetSymbol(Group, Symbol : String);
    Var
      G : TGroup;
    Begin
      Assert(InCorrectThread, 'TGroupList.SetSymbol called from wrong thread.');
      If Group = '' Then Exit;
      G := GetGroup(Self, Group);
      If Assigned(G) Then
        G.SetSymbol(Symbol)
    End;

  Function TGroupList.GetSymbol(Group : String) : String;
    Var
      G : TGroup;
    Begin
      Assert(InCorrectThread, 'TGroupList.GetSymbol called from wrong thread.');
      Result := '';
      G := GetGroup(Self, Group);
      If Assigned(G) Then
        Result := G.GetSymbol
    End;


  Function TGroupList.NewGroup : String;
    Begin
      Repeat
        Inc(LastGroup);
        Result := Format('Untitled #%d', [LastGroup])
      Until Not Assigned(GetGroup(Self, Result))
    End;

  Var
    GroupList : TGroupList;

  Class Function TGroupList.Instance : TGroupList;
    Begin
      If Not Assigned(GroupList) Then
        GroupList := TGroupList.Create;
      Result := GroupList
    End;

Initialization
  InCorrectThread := True


End.