RnQ/RnQ/roasterLib.pas

{
  This file is part of R&Q.
  Under same license
}
unit roasterLib;
{$I RnQConfig.inc}

interface

uses
  System.Classes, Generics.Collections,
  RDGlobal, RnQPics, ICQContacts, Nodes;

{$I PubRTTI.inc}

type
  TRnQCLIconsSet = (CNT_ICON_VIS, CNT_ICON_STS, CNT_ICON_XSTS, CNT_ICON_AUTH, CNT_ICON_LCL, CNT_TEXT, CNT_ICON_BIRTH, CNT_ICON_AVT, CNT_ICON_VER);
  TRnQCLIcons = record
    idx: TRnQCLIconsSet;
    Name: String;
    IconName: TPicName;
    PrefText: AnsiString;
  end;
  {$I NoRTTI.inc}
const
  // RnQCLIcons : array[0..6] of TRnQCLIcons = (
  RnQCLIcons: array [TRnQCLIconsSet] of TRnQCLIcons = ((idx: CNT_ICON_VIS; Name: 'I''m visible to'; IconName: PIC_VISIBLE_TO;
    PrefText: 'visibility-flag'), (idx: CNT_ICON_STS; Name: 'Status'; IconName: 'status.online'; PrefText: 'show-status'),
    (idx: CNT_ICON_XSTS; Name: 'XStatus'; IconName: 'st_custom.cigarette'; PrefText: 'show-xstatus-flag'),
    (idx: CNT_ICON_AUTH; Name: 'Not authorized'; IconName: PIC_AUTH_NEED; PrefText: 'show-need-auth-flag'), (idx: CNT_ICON_LCL;
    Name: 'Is local'; IconName: PIC_LOCAL; PrefText: 'show-is-local-flag'), (idx: CNT_TEXT; Name: 'Displayed'; IconName: PIC_INFO;
    PrefText: 'text'), (idx: CNT_ICON_BIRTH; Name: 'Birthday baloon'; IconName: PIC_BIRTH; PrefText: 'show-birth-day-flag'),
    (idx: CNT_ICON_AVT; Name: 'Avatar'; IconName: 'avatar'; PrefText: 'show-avatar-flag'), (idx: CNT_ICON_VER; Name: 'IM icon';
    IconName: PIC_RNQ; PrefText: 'show-client-flag'));

var
  SHOW_ICONS_ORDER: array [0 .. Byte(High(TRnQCLIconsSet))] of TRnQCLIconsSet;
  TO_SHOW_ICON: array [TRnQCLIconsSet] of Boolean;

  function ContactsUnder(n: TNode): Integer;
  //function CompareNodes(Node1, Node2: TNode): Integer;
  procedure RebuildCL;
  procedure Update(c: TICQContact);
  procedure UpdateInPlace(c: TICQContact);
  // function Exists(c: TRnQContact): Boolean;
  function Focus(c: TICQContact): Boolean; overload;
  function Focus(n: TNode): Boolean; overload;
  // function Remove(c: TContact): Boolean;
  function Remove(c: TICQContact): Boolean;
  function AddGroup(const Name: String): Integer;
  function RemoveGroup(id: Integer): Boolean;
  procedure Edit(n: TNode);
  procedure Expand(n: TNode);
  procedure Collapse(n: TNode);
  procedure Clear;
  procedure SetOnlyOnline(v: Boolean);
  procedure SetNewGroupFor(c: TICQContact; grp: Integer);
  function IsUnderDiv(n: TNode): TDivisor;
  function GetContactDiv(c: TICQContact; IsRoster: Boolean = False): TDivisor;
  function ICON_ORDER_PREF: RawByteString;
  procedure ICON_ORDER_PREF_parse(const str: RawByteString);

var
  Building: Boolean = False;
  inplace: record
    what: Integer;
    contact: TICQContact;
    groupId: Integer;
    groupAction: TGroupAction;
    node: TNode;
  end;

implementation

uses
  System.SysUtils,
  SciterLib, utilLib, globalLib, groupsLib, RDUtils,
  ICQSession, ICQConsts;

var
  BuildingOnline: Boolean;

//function Filtered(c: TICQContact): Boolean;
//begin
//  if FilterTextBy = '' then
//    Result := False
//  else if c = nil then
//    Result := True
//  else if (Pos(FilterTextBy, AnsiUpperCase(c.UID)) = 0) and (Pos(FilterTextBy, AnsiUpperCase(c.Display)) = 0) and
//    (Pos(FilterTextBy, AnsiUpperCase(c.Nick)) = 0) and (Pos(FilterTextBy, AnsiUpperCase(c.First)) = 0) and
//    (Pos(FilterTextBy, AnsiUpperCase(c.Last)) = 0)
//  // and(Pos(FilterTextBy, AnsiUpperCase(c.email)) = 0)
//  then
//    {
//      if (not MatchesMask(c.UID, FilterTextBy)) and
//      (not MatchesMask(c.display, FilterTextBy)) and
//      (not MatchesMask(c.nick, FilterTextBy)) and
//      (not MatchesMask(c.first, FilterTextBy)) and
//      (not MatchesMask(c.last, FilterTextBy)) and
//      (not MatchesMask(c.email, FilterTextBy)) then
//    }
//    Result := True
//  else
//    Result := False;
//end;

function InsertNode(d: TDivisor): TNode; overload;
begin
  Result := nil;
  if not (d in [Low(TDivisor) .. High(TDivisor)]) then
    Exit;
  Result := divs[d];
  if Assigned(Result) then
    Exit;

  Result := TNode.Create(d);
  UI.CL.InsertNode(Result);
  divs[d] := Result;
end;

function InsertNode(id: Integer; d: TDivisor): TNode; overload;
var
  p: TGroup;
  Parent: TNode;
begin
  p := groups.Get(id);
  Result := p.Node[d];
  if Assigned(Result) then
    Exit;
  Parent := InsertNode(d); // ensure divisor existence
  Result := TNode.Create(id, d);
  Result.order := p.Order;
  Result.parent := Parent;
  groups.SetNode(id, d, Result);
  UI.CL.InsertNode(Result);
end;

function ShouldBeUnder(c: TICQContact; d: TDivisor): TNode;
begin
  Result := InsertNode(d);
  if (c.group = 0) or not ShowGroups or not (d in divsWithGroups) then
    Exit;
  if not groups.exists(c.group) then
    c.group := 0
  else
    Result := InsertNode(c.group, d);
end;

function InsertNode(c: TICQContact; under: TNode): TNode; overload;
begin
  Result := TNode.Create(under.divisor, c);
  Result.parent := under;
  if not ShowGroups then
    Result.groupId := 0;
  UI.CL.InsertNode(Result);
end;

function InsertNode(c: TICQContact; d: TDivisor): TNode; overload;
begin
  Result := InsertNode(c, ShouldBeUnder(c, d))
end;

function GetContactDiv(c: TICQContact; IsRoster: Boolean = False): TDivisor;
begin
  if (not IsRoster) and NotInList.exists(c) then
    Result := d_nil
  else if (not IsRoster) and not c.IsInRoster then
    Result := TDivisor(13)
  else if BuildingOnline and not OnlOfflInOne then
    if EnableRecentlyOffline and TICQContact(c).IsRecent then
      Result := d_recent
    else if c.IsOffline or (ShowUnkAsOffline and not c.IsOnline) then
      Result := d_offline
    else
      Result := d_online
  else if BuildingOnline and ShowOnlyOnline and not c.IsOnline then
    Result := d_offline
  else
    Result := d_contacts
end;

function InsertNode(c: TICQContact): TNode; overload;
var
  d: TDivisor;
begin
  d := GetContactDiv(c);
  // if d in [d_online..d_nil] then
  if d in [Low(TDivisor) .. High(TDivisor)] then
    Result := InsertNode(c, d)
  else
    Result := nil;
end;

function RemoveNode(n: TNode): Boolean; overload;
var
  Parent: TNode;
begin
  Result := Assigned(n);
  if not Result then
    Exit;

  UI.CL.RemoveNode(n);

  Parent := n.Parent;
  FreeAndNil(n);

  if Parent = nil then
    Exit;

  if Parent.ChildrenCount = 0 then
  case Parent.kind of
    NODE_GROUP:
      if not (ShowGroups and ShowEmptyGroups and (Parent.divisor = d_contacts)) then
        RemoveNode(Parent);
    NODE_DIV:
      if Parent.divisor in [d_nil, d_contacts] then
        RemoveNode(Parent);
  end;
end;

function RemoveNode(c: TICQContact): Boolean; overload;
begin
  Result := RemoveNode(TCE(c.data^).Node);
  TCE(c.data^).Node := nil;
end;

procedure RebuildCL;
var
  d: TDivisor;
  c: TICQContact;
  g: TPair;

//  Freq, StartCount, StopCount: Int64;
//  TimingSeconds: Real;
begin
  if UserStarting or Building then
    Exit;

  try
    Building := True;
    Clear;
//QueryPerformanceFrequency(Freq);
//QueryPerformanceCounter(StartCount);
    for d := Low(TDivisor) to High(TDivisor) do
      if Assigned(divs[d]) then
        FreeAndNil(divs[d]);
    if groups = nil then
      Exit;

    BuildingOnline := Account.AccProto.isOnline;
    if BuildingOnline and not OnlOfflInOne then
    begin
      InsertNode(d_online);
      if (EnableRecentlyOffline) then
        InsertNode(d_recent);
      InsertNode(d_offline);
    end;

    Account.AccProto.readList(LT_ROSTER).ForEach(procedure(c: TICQContact)
    begin
      d := GetContactDiv(c, True);
      InsertNode(c, d);
    end);

    // Add empty groups too
    if ShowGroups and ShowEmptyGroups then
      for g in groups.GList do
        if Account.AccProto.readList(LT_ROSTER).GetCount(g.Value.ID) = 0 then
          InsertNode(g.Value.ID, d_contacts);

    // nil section
    if Assigned(NotInList) then
    with NotInList do
    begin
      resetEnumeration;
      while hasMore do
      begin
        c := getNext;
        InsertNode(c, d_nil);
      end;
    end;

    // expand groups
    for d := Low(d) to High(d) do
      if Assigned(divs[d]) then
        groups.SetNodesExpanded(d);

  finally
//QueryPerformanceCounter(StopCount);
//TimingSeconds := (StopCount - StartCount) / Freq;
//ODS('CL rebuild: ' + floattostr(TimingSeconds));
    Building := False;
    UI.CL.FinishBuild;
  end;
end;

procedure Update(c: TICQContact);
var
  Node: TNode;
  WasFocused: Boolean;
begin
  if c = nil then
    Exit;
  WasFocused := c = clickedContact;
  Node := TCE(c.data^).Node;
  if Assigned(Node) and (IsUnderDiv(Node) = GetContactDiv(c)) and (Node.groupId = c.Group) then
    UI.CL.UpdateContact(c)
  else
  begin
    RemoveNode(c);
    Node := InsertNode(c);
  end;

  TCE(c.data^).Node := Node;
  if WasFocused then
    Focus(c);

  if Assigned(UI.Chat) then
    UI.Chat.RedrawChatTab(c);
end;

procedure UpdateInPlace(c: TICQContact);
begin
  if c = nil then
    Exit;
  UI.CL.UpdateContact(c);
  if Assigned(UI.Chat) then
    UI.Chat.RedrawChatTab(c);
end;

function Remove(c: TICQContact): Boolean;
begin
  Result := False;
  if not Assigned(c) then
    Exit;
  Result := Account.AccProto.RemoveContact(TICQContact(c)) or Result;
  ActionManager.Execute(AK_SAVECONFIG, SaveDelay);
  RemoveNode(c);
  if Assigned(UI.Chat) then
    UI.Chat.UserChanged(c);
end;

function Exists(c: TICQContact): Boolean;
begin
  Result := (c <> nil) and (c.data <> nil) and (TCE(c.data^).Node <> nil)
end;

function Focus(n: TNode): Boolean; overload;
begin
  Result := Assigned(n);
  if not Result then
    Exit;
  UI.CL.FocusNode(n);
  clickedNode := n;
  clickedContact := n.contact;
end;

function Focus(c: TICQContact): Boolean; overload;
begin
  Result := Assigned(c) and Focus(TCE(c.data^).Node)
end;

procedure Clear;
var
  d: TDivisor;
begin
  UI.CL.Clear;

  while ContactsPool.Count > 0 do
    FreeAndNil(TNode(ContactsPool.Last));

  groups.ClearNodes;

  for d := Low(TDivisor) to High(TDivisor) do
    FreeAndNil(divs[d]);
end;

function AddGroup(const Name: String): Integer;
var
  d: TDivisor;
  First: TNode;
begin
  // create the new group
  Result := groups.AddWithValues(0, Name);
  // add it to divisors, and focus on the first one
  First := nil;
  d := d_contacts;
  if not Assigned(divs[d]) then
  if not Account.AccProto.IsOnline or (Account.AccProto.IsOnline and not showOnlyOnline) then
    d := d_offline;
  if not Assigned(divs[d]) and Account.AccProto.IsOnline then
    d := d_online;
  if Assigned(divs[d]) then
    First := InsertNode(Result, d);
  if Assigned(First) then
    UI.CL.EditNode(First, GA_Add);
  Focus(First);
  ActionManager.Execute(AK_SAVEGROUPS, SaveDelay);
end;

function RemoveGroup(id: Integer): Boolean;
var
  cl: TRnQCList;
  c: TICQContact;
  d: TDivisor;
begin
  Result := groups.Exists(id);
  if not Result then
    Exit;
  cl := Account.AccProto.readList(LT_ROSTER).clone;
  for c in cl do
    if c.group = id then
      Remove(c);
  cl.Free;
  with groups.Get(id) do
    for d := Low(d) to High(d) do
      RemoveNode(Node[d]);
  groups.Remove(id);
  ActionManager.Execute(AK_SAVEGROUPS, SaveDelay);
end;

procedure Edit(n: TNode);
begin
  if n = nil then
    Exit;
  if not (n.kind in [NODE_GROUP, NODE_CONTACT]) then
    Exit;
  if not UI.CL.Visible then
    UI.CL.ToggleVisible;
  if (n.kind = NODE_CONTACT) and not n.contact.canEdit then
    Exit;
  if not UI.CL.Visible then
    Exit;
  focus(n);
end;

procedure Expand(n: TNode);
begin
  if Assigned(n) then
    n.SetExpanded(True)
end;

procedure Collapse(n: TNode);
begin
  if Assigned(n) then
    n.SetExpanded(False)
end;

procedure SetOnlyOnline(v: Boolean);
begin
  showOnlyOnline := v;
  ActionManager.Execute(AK_SAVECONFIG, SaveDelay);
  UI.CL.InitSettings;
  if OnlOfflInOne then
    RebuildCL
end;

procedure SetNewGroupFor(c: TICQContact; grp: Integer);
begin
  if c.cntIsLocal or Account.AccProto.UpdateGroupOf(TICQContact(c), grp) then
  begin
    c.group := grp;
    Update(c);
    ActionManager.Execute(AK_UPDATEDB, 1000);
  end;
end;

function IsUnderDiv(n: TNode): TDivisor;
begin
  Result := d_contacts;
  try
    while Assigned(n) do
    if n.kind = NODE_DIV then
    begin
      Result := n.divisor;
      Exit;
    end else
      n := n.parent;
  except end;
enD;

function ContactsUnder(n: TNode): Integer;
begin
  Result := 0;
  n := n.firstChild;
  while n <> nil do
  begin
    if n.ChildrenCount > 0 then
      Inc(Result, contactsUnder(n));
    if n.kind = NODE_CONTACT then
      Inc(Result);
    n := n.next;
  end;
end;

function ICON_ORDER_PREF: RawByteString;
var
  a: TRnQCLIconsSet;
begin
  Result := ';';
  for a in SHOW_ICONS_ORDER do
    Result := Result + RnQCLIcons[a].PrefText + ';';
end;

procedure ICON_ORDER_PREF_parse(const str: RawByteString);
  function can_add(idx: Byte; a: TRnQCLIconsSet): Boolean;
  var
    i: Integer;
  begin
    Result := True;
    for i := 0 to idx - 1 do
      if SHOW_ICONS_ORDER[i] = a then
      begin
        Result := False;
        break;
      end;
  end;

var
  a: TRnQCLIconsSet;
  cur: Byte;
  s: RawByteString;
  ss: RawByteString;
begin
  cur := Byte(low(TRnQCLIconsSet));
  ss := str;
  while (s = '') and (ss > '') do
    s := chop(AnsiString(';'), ss);
  while (s > '') and (ss > '') do
  begin
    for a in [low(TRnQCLIconsSet) .. High(TRnQCLIconsSet)] do
      if (s = RnQCLIcons[a].PrefText) and can_add(cur, a) then
      begin
        SHOW_ICONS_ORDER[cur] := a;
        Inc(cur);
      end;
    s := chop(AnsiString(';'), ss);
  end;
  if cur <= Byte(High(TRnQCLIconsSet)) then
    for a in [low(TRnQCLIconsSet) .. High(TRnQCLIconsSet)] do
      if can_add(cur, a) then
      begin
        SHOW_ICONS_ORDER[cur] := a;
        Inc(cur);
      end;
end;

initialization
  ContactsPool := TList.Create;
  sortBy := SB_event;

finalization
  FreeAndNIl(ContactsPool);
  FreeAndNil(ContactsTheme);

end.