RnQ/RnQ/roasterLib.pas

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

interface

uses
  Windows, Classes, StdCtrls, Graphics, Generics.Collections,
  RDGlobal, RnQPics, ThemesLib, ICQContacts, ICQCommon, Nodes;

{$I NoRTTI.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);
{$I PubRTTI.inc}
  TRnQCLIcons = record
    // IDX  : Byte;
    idx: TRnQCLIconsSet;
    Name: String;
    IconName: TPicName;
    PrefText: AnsiString;
    // Cptn : String;
    // DefShortCut : String;
    // ev   : procedure;
  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;
function Str2Divisor(const s: AnsiString): TDivisor;
procedure Rebuild;
procedure Update(c: TICQContact);
procedure UpdateInPlace(c: TICQContact);
procedure UpdateEmptyGroups;
// 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; ga: TGroupAction = GA_None);
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;
  dragging: Boolean = False; // roster.dragging doesn't work
  inplace: record
    edit: TEdit;
    what: Integer;
    contact: TICQContact;
    groupId: Integer;
    groupAction: TGroupAction;
    node: TNode;
  end;

{$IFDEF USE_SECUREIM}
  useSecureIM: Boolean;
{$ENDIF USE_SECUREIM}

implementation

uses
  {UxTheme, DwmApi,} Types, UITypes,
  RnQGraphics32, RQUtil, RQThemes,
  RnQStrings, RnQLangs, RDUtils, RnQSysUtils,
  mainDlg, chatDlg, sysutils, utilLib, globalLib, groupsLib,
  ICQSession, ICQConsts,
  events,
{$IFDEF USE_SECUREIM}
  cryptoppWrap,
{$ENDIF USE_SECUREIM}
  // masks,
  StrUtils;

var
  // declared globally to speedup the compare callback functions

  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 Str2Divisor(const s: AnsiString): TDivisor;
begin
  for Result := Low(Result) to High(Result) do
    if s = divisor2str[Result] then
      Exit;
  raise Exception.create('str2divisor');
end; // Str2Divisor

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);
  RnQmain.CLBox.InsertNode(Result);
  divs[d] := Result;
end; // InsertNode

function InsertNode(id: Integer; d: TDivisor): TNode; overload;
var
  p: TGroup;
  Parent, EmptyParent: 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);
  RnQmain.CLBox.InsertNode(Result);
end; // InsertNode

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; // ShouldBeUnder

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;
  RnQmain.CLBox.InsertNode(Result);
  autosizeDelayed := True;
end; // InsertNode

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; // InsertNode

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

  RnQMain.CLBox.RemoveNode(n);

  Parent := n.Parent;
  n.Free;

  if Parent = nil then
    Exit;

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

function RemoveNode(c: TICQContact): Boolean; overload;
var
  n: TNode;
begin
  n := TCE(c.data^).node;

  Result := RemoveNode(TCE(c.data^).Node);
  if Result then
    autosizeDelayed := True;

  TCE(c.data^).Node := nil;
end;

procedure UpdateEmptyGroups;
//var
//  g: TPair;
//  Group: TGroup;
begin
//  if ShowGroups and ShowEmptyGroups then
//    for g in groups.GList do
//      if Account.AccProto.readList(LT_ROSTER).GetCount(g.Value.ID, Integer(d_contacts)) = 0 then
//        InsertNode(g.Value.ID, d_contacts)
//  else begin
//    Group := groups.Get(g.Value.ID);
//    if (Group.ID > 0) and Assigned(Group.Node[d_contacts]) then
//      RemoveNode(Group.Node[d_contacts])
//  end;
end;

procedure Rebuild;
var
  d: TDivisor;
  c: TICQContact;
  oldClickedContact: TICQContact;
  g: TPair;

  Freq, StartCount, StopCount: Int64;
  TimingSeconds: Real;
begin
  if UserStarting or building then
    Exit;
  oldClickedContact := clickedContact;
  // oldtopnode := RnQmain.roster.TopNode;
  try
    building := True;
    // with RnQmain.roster.treeoptions do autooptions:=autoOptions-[toAutosort];
    // reset

    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;
//    groups.FillNodes;

    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);

    // with RnQmain.roster.treeoptions do autooptions:=autoOptions+[toAutosort];
    autosizeDelayed := True;
  finally
QueryPerformanceCounter(StopCount);
TimingSeconds := (StopCount - StartCount) / Freq;
ODS('CL rebuild: ' + floattostr(TimingSeconds));
    building := False;

    RnQmain.CLBox.FinishBuild;
    // sort(RnQmain.roster.RootNode);
  end;
end; // Rebuild

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)) then
  begin
    if Node.groupId = c.group then
      RnQmain.CLBox.UpdateContact(c)
    else
    begin
      RemoveNode(c);
      Node := InsertNode(c);
    end;
  end
    else
  begin
    RemoveNode(c);
    Node := InsertNode(c);
  end;

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

  if Assigned(chatFrm) then
    chatFrm.RedrawTab(c);
end; // Update

procedure UpdateInPlace(c: TICQContact);
begin
  if c = nil then
    Exit;
  RnQmain.CLBox.UpdateContact(c);
  if Assigned(chatFrm) then
    chatFrm.RedrawTab(c);
end;

function Remove(c: TICQContact): Boolean;
begin
  Result := False;
  if not Assigned(c) then
    Exit;
  Result := Account.AccProto.RemoveContact(TICQContact(c)) or Result;
  SaveListsDelayed := True;
  RemoveNode(c);
  if Assigned(chatFrm) then
    chatFrm.UserChanged(c);
end; // Remove

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;
  RnQmain.CLBox.FocusNode(n);
  clickedNode := n;
  clickedContact := n.contact;
end; // focus

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

procedure Clear;
var
  d: TDivisor;
begin
  RnQmain.CLBox.ClearCL;

  while contactsPool.count > 0 do
    TNode(contactsPool.last).Free;

  groups.ClearNodes;

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

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
    RnQmain.CLBox.EditNode(First, GA_Add);
  Focus(First);
  SaveGroupsDelayed := True;
end; // AddGroup

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);
  SaveGroupsDelayed := True;
end; // RemoveGroup

procedure Edit(n: TNode; ga: TGroupAction = GA_None);
begin
  FreeAndNil(inplace.edit);
  if n = nil then
    Exit;
  if not (n.kind in [NODE_GROUP, NODE_CONTACT]) then
    Exit;
  if not formVisible(RnQmain) then
    RnQmain.ToggleVisible();
  if (n.kind = NODE_CONTACT) and not n.contact.canEdit then
    Exit;
  if not formVisible(RnQmain) then
    Exit;
  focus(n);
end; // Edit

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;
  saveCfgDelayed := True;
  RnQmain.CLBox.InitSettings;
  if OnlOfflInOne then
    Rebuild
end; // SetOnlyOnline

procedure SetNewGroupFor(c: TICQContact; grp: Integer);
begin
  if c.cntIsLocal or Account.AccProto.UpdateGroupOf(TICQContact(c), grp) then
  begin
    c.group := grp;
    Update(c);
    dbUpdateDelayed := True;
  end;
end; // SetNewGroupFor

function IsUnderDiv(n: TNode): TDivisor;
begin
  Result := d_contacts;
  while n <> nil do
  if n.kind = NODE_DIV then
  begin
    Result := n.divisor;
    Exit;
  end else
    n := n.parent;
enD; // IsUnderDiv

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; // ContactsUnder

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;
// ContactThemes := TRQtheme.Create;
{$IFDEF USE_SECUREIM}
useSecureIM := loadlib;
{$ENDIF USE_SECUREIM}

FINALIZATION

contactsPool.free;
contactsPool := nil;
if assigned(ContactsTheme) then
  ContactsTheme.free;
ContactsTheme := nil;

end.