RnQ/RnQ/groupsLib.pas

{
  Copyright (C) 2002-2004  Massimo Melina (www.rejetto.com)

  This file is part of &RQ.

  &RQ is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2 of the License, or
  (at your option) any later version.

  &RQ is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with &RQ; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
}
{$I RnQConfig.inc}
unit groupsLib;

interface

uses
  Windows, Classes, Generics.Collections,
  roasterlib, RDGlobal;

{$I NoRTTI.inc}

type
  TGroup = record
    IsLocal: Boolean;
    ID: Integer;
    Order: Integer;
    Name: String;
    Node: array [TDivisor] of TNode;
    Expanded: array [TDivisor] of Boolean;
    function ServerUpdate(ga: TGroupAction; const old: String = ''): Boolean;
  end;

type
  TGroups = class
  public
    GList: TDictionary;
    procedure Clear;
    procedure MakeAllLocal;
    procedure FillNodes;
    procedure FromString(s: RawByteString);
    function ToString: RawByteString; reintroduce;
//    function IdxOf(id: Integer): Integer;
    function AddEmpty: Integer;
    function AddWithValues(ID: Integer = 0; const Name: String = ''): Integer;
    function Get(id: Integer): TGroup;
    function Exists(ID: Integer): Boolean; overload;
    function Exists(const Name: String): Boolean; overload;
    function Count: Integer;
    function RenameLocal(ID: Integer; const NewName: String): TPair;
    procedure Rename(ID: Integer; const NewName: String);
    function Remove(ID: Integer): Boolean; overload;
    function Remove(const Name: String): Boolean; overload;
    function Name2ID(const Name: string): Integer;
    function ID2Name(ID: Integer): String;
    function FreeID: Integer;

    // Change values from outside
    procedure SetExpanded(ID: Integer; d: TDivisor; val: Boolean);
    procedure SetOrder(ID, order: Integer);
    procedure SetNode(ID: Integer; d: TDivisor; Node: TNode);
    procedure SetLocal(ID: Integer; IsLocal: Boolean);

    // Helpers
    procedure AddGroupsToList(var ss: TStringList; pAddOut: Boolean);
    procedure SetNodesExpanded(d: TDivisor);

    constructor Create;
    destructor Destroy; override;
  private
    procedure SaveGroup(Group: TGroup);
  end; // TGroups

implementation

uses
  utilLib, globalLib, SysUtils,
{$IFDEF UNICODE}
  AnsiStrings,
{$ENDIF UNICODE}
  RDUtils, ICQSession;

var
  g: TPair;

constructor TGroups.Create;
begin
  inherited;
  GList := TDictionary.Create;
end;

destructor TGroups.Destroy;
begin
  GList.Clear;
  FreeAndNil(GList);
  inherited;
end;

function TGroups.Get(ID: Integer): TGroup;
begin
  Result := Default(TGroup);
  for g in GList do
  if g.Value.ID = ID then
  begin
    Result := g.Value;
    Exit;
  end;
end;

const
  StringSeparator = ';';

procedure TGroups.FromString(s: RawByteString);
var
  k, Line: RawByteString;
  p: TGroup;
  d: TDivisor;
begin
  Clear;
  while s > '' do
  begin
    Line := chopLine(s);
    k := Trim(chop(AnsiString('='), Line));
    Line := Trim(Line);
    if IsOnlyDigits(k) then
    try
      p := Default(TGroup);
      p.ID := StrToInt(k);
      p.Name := Trim(UnUTF(Line));
      p.Order := 0;
      for d := Low(d) to High(d) do
      begin
        p.Node[d] := nil;
        p.Expanded[d] := True;
      end;
    except end
    else if k = 'order' then
    try
      p.Order := StrToInt(Line)
    except end
    else if k = 'collapsed' then
    while Line > '' do
    try
      p.Expanded[Str2Divisor(chop(StringSeparator, Line))] := False;
    except end
    else if k = 'ssi' then
    try
      p.IsLocal := Line = '0';
      if not (p.Name = '') then
        GList.AddOrSetValue(p.Name, p);
    except end;
  end;
end; // FromString

function TGroups.ToString: RawByteString;
var
  i: Integer;
  d: TDivisor;
begin
  Result := '';
  for g in GList do
  begin
    Result := Result + Format(AnsiString('%d=%s' + CRLF + 'order=%d' + CRLF + 'collapsed='), [g.Value.ID, UTF(g.Value.name), g.Value.order]);
    for d := Low(d) to High(d) do
      if not g.Value.Expanded[d] then
        Result := Result + Divisor2Str[d] + StringSeparator;
    Result := Result + Format(AnsiString(CRLF + 'ssi=%d'), [IfThen(g.Value.IsLocal, 0, 1)]);
    Result := Result + CRLF;
  end;
end; // ToString

procedure TGroups.Clear;
var
  i: Integer;
  d: TDivisor;
begin
  for g in GList do
  begin
    for d := Low(TDivisor) to High(TDivisor) do
      g.Value.Node[d].Free;
  end;
  GList.Clear;
end;

procedure TGroups.MakeAllLocal;
var
  p: TGroup;
begin
  for g in GList do
  begin
    p := g.Value;
    p.IsLocal := True;
    SaveGroup(p);
  end;
end;

procedure TGroups.FillNodes;
var
  p: TGroup;
begin
  for g in groups.GList do
  begin
    p := g.Value;
    FillChar(p.Node, SizeOf(p.Node), 0);
    groups.GList.Items[p.Name] := p;
  end;
end;

procedure TGroups.SetNodesExpanded(d: TDivisor);
begin
  for g in groups.GList do
  if Assigned(g.Value.Node[d]) then
    g.Value.Node[d].SetExpanded(g.Value.Expanded[d])
end;

procedure TGroups.SetExpanded(ID: Integer; d: TDivisor; val: Boolean);
var
  p: TGroup;
begin
  p := Get(ID);
  if p.Name = '' then
    Exit;
  p.Expanded[d] := val;
  SaveGroup(p);
end;

procedure TGroups.SetOrder(ID, order: Integer);
var
  p: TGroup;
begin
  p := Get(ID);
  if p.Name = '' then
    Exit;
  p.Order := order;
  SaveGroup(p);
end;

procedure TGroups.SetNode(ID: Integer; d: TDivisor; Node: TNode);
var
  p: TGroup;
begin
  p := Get(ID);
  if p.Name = '' then
    Exit;
  p.Node[d] := Node;
  SaveGroup(p);
end;

procedure TGroups.SetLocal(ID: Integer; IsLocal: Boolean);
var
  p: TGroup;
begin
  p := Get(ID);
  if p.Name = '' then
    Exit;
  p.IsLocal := IsLocal;
  SaveGroup(p);
end;

procedure TGroups.SaveGroup(Group: TGroup);
begin
  if not (Group.Name = '') then
    GList.AddOrSetValue(Group.Name, Group);
end;
{
function TGroups.idxOf(id: integer): integer;
begin
  for result := 0 to count - 1 do
    if a[result].id = id then
      exit;
  result := -1;
end; // idxOf
}
function TGroups.FreeID: Integer;
var
  i: Integer;
begin
  Result := 1000;
  for g in GList do
    if g.Value.ID >= Result then
      Result := g.Value.ID + 1;
end; // FreeID

function TGroups.AddEmpty: Integer;
begin
  Result := AddWithValues;
end;

function TGroups.AddWithValues(ID: Integer = 0; const Name: String = ''): Integer;
var
  d: TDivisor;
  gr: TGroup;
begin
  if ID = 0 then
    gr.ID := FreeID
  else
    gr.ID := ID;
  gr.Name := Name;
  gr.Order := 0;
  for d := Low(d) to High(d) do
  begin
    gr.Node[d] := nil;
    gr.Expanded[d] := True;
  end;
  GList.AddOrSetValue(gr.Name, gr);
  Result := gr.ID;
end; // AddWithID

function TGroups.Exists(ID: Integer): Boolean;
begin
  Result := False;
  for g in GList do
    if g.Value.ID = ID then
      Result := True;
end;

function TGroups.Exists(const Name: String): Boolean;
begin
  Result := GList.ContainsKey(Name);
end;

function TGroups.RenameLocal(ID: Integer; const NewName: String): TPair;
var
  p: TGroup;
begin
  Result := Default(TPair);
  p := Get(ID);
  Result.Key := p.Name;
  if p.Name = '' then
    Exit;
  GList.Remove(p.Name);
  p.Name := NewName;
  GList.AddOrSetValue(NewName, p);
  Result.Value := p;
end;

procedure TGroups.Rename(ID: Integer; const NewName: String);
var
  Res: TPair;
begin
  Res := RenameLocal(ID, NewName);
  if not (Res.Key = '') then
    Res.Value.ServerUpdate(GA_Rename, Res.Key);
end;

function TGroups.Remove(ID: Integer): Boolean;
var
  i: Integer;
  p: TGroup;
begin
  p := Get(ID);
  Result := not (p.Name = '');
  if not Result then
    Exit;
  GList.Remove(p.Name);
  if not p.IsLocal then
    if Account.AccProto.IsReady then
      Account.AccProto.SendUpdateGroup(p.Name, GA_Remove);
end; // Remove

function TGroups.Remove(const Name: String): Boolean;
var
  i: Integer;
  p: TGroup;
begin
  Result := GList.TryGetValue(Name, p);;
  if not Result then
    Exit;
  GList.Remove(p.Name);
  if not p.IsLocal then
    if Account.AccProto.IsReady then
      Account.AccProto.SendUpdateGroup(p.Name, GA_Remove);
end; // Remove

function TGroups.ID2Name(ID: Integer): String;
begin
  Result := Get(ID).Name
end; // ID2Name

function TGroups.Name2ID(const Name: String): Integer;
var
  p: TGroup;
begin
  if GList.TryGetValue(Name, p) then
    Result := p.ID
  else
    Result := 0;
end; // Name2ID

function TGroups.Count: Integer;
begin
  Result := GList.Count;
end;

procedure TGroups.AddGroupsToList(var ss: TStringList; pAddOut: Boolean);
begin
  for g in GList do
    if pAddOut or not g.Value.IsLocal then
      ss.AddObject(dupAmpersand(g.Value.Name), Tobject(g.Value.ID));
end;

{ TGroup }

function TGroup.ServerUpdate(ga: TGroupAction; const old: String = ''): Boolean;
begin
  Result := Account.AccProto.SendUpdateGroup(Name, ga, old);
end;

end.