unit ULObjUsrNodeu; { ULObjUsr descendant for making trees of existing ULObjs }
{
  (C) 2000 - 2002 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan/
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}
interface
uses
  {$IFNDEF CONSOLE}
  Windows, Messages, Dialogs, Forms, {v0.62} ComCtrls,{/v0.62}
  ULStringGrid,
  {$ENDIF}
  Classes, SysUtils,
  UtlType, WinUtl, Msgu,
  ULRecTyp, ULRecUtl, ULObju, ULObjDes,
  ULObjUsru;
const

  nnULFFiles = 'ULFFiles';
  nnActiveChannel = 'ActiveChannel';
    nnActiveSequence = 'ActiveSequence';
      nnActiveSample = 'ActiveSample';
      nnActiveProgram = 'ActiveProgram';

  MaxLinkNames = 5;

  LinkNames: array[0..MaxLinkNames-1] of string = (
    nnULFFiles, nnActiveChannel, nnActiveProgram, nnActiveSequence, nnActiveSample
  );

type
  TULObjUsrNode = class(TULObjUsr)
  private
    FLinkName: string;
      { this node is link to other subtree if <> '' (i.e. don't destroy in ChildsUpdate)}
    {v0.62}
    FTreeNodes: TList; { tree nodes (from dif.treeviews) using this node }
    function TreeNodes: TList;
    {/v0.62}
  protected
    {v0.62}
    procedure ObjUpdated;override;
    {/v0.62}
    procedure ChildsUpdate; override;
    function ChildCreate(AChildObj: TULObj): TULObjUsr; override;
    function GetRecID: TULRecID; override;
    function GetCaption: string; override;
    {v0.67}
    class function GetClassRecID: TULRecID; override;
    {/v0.67}
  public
    {v0.62}
    destructor Destroy; override;
    { Treenode that uses this ulobjusrnode should call this method
      (to get notification about destroying the node) }
    procedure TreeNodeRegister(ATreeNode: pointer);
    { Treenode that is going to be destroyed should call this method to
      remove itself from the registered (to be notified about ulobjusrnode
      destroying) TreeNodes }
    procedure TreeNodeUnregister(ATreeNode: pointer);
    { Free TreeNodes. Called when this ulobjusrnode is going to be destroyed. }
    procedure TreeNodesRelease;
    {/v0.62}
    function LinkAdd(AChildObj: TULObj; const ALinkName: string): TULObjUsrNode;
      { for adding Link nodes (other get created automatically) }
    {function LinkFind(const ALinkName: string; var ANode: TULObjUsrNode): boolean;}
    {function FindByULObjPath(const AULObjPath: string; fo: TULRecFindOptions;
      var AObj: TULObj): boolean;}
    property LinkName: string read FLinkName write FLinkName;
  end;

  TULObjUsrTree = class(TULObjUsrNode) {creates root tree copy}
  private
    FULFFiles: TULObjUsrNode;
    {function GetActiveChannel: TULObj;
    procedure SetActiveChannel(AObj: TULObj);}
  protected
    {v0.62}
    procedure ObjUpdated;override;
    procedure FilesUpdate;
    {/v0.62}
    {v0.64}
    class function GetClassRecID: TULRecID; override;
    {/v0.64}
  public
    constructor Create; reintroduce;
    {v0.72}
    destructor Destroy; override;
    {/v0.72}
    {property ActiveChannel: TULObj read GetActiveChannel write SetActiveChannel;}
    property ULFFiles: TULObjUsrNode read FULFFiles;
  end;

{Returns snapshot of current ulffiles}
function ULRootTree: TULObjUsrTree;

implementation
uses
  ULObjUsrTreeViewu;

function ULRootTree: TULObjUsrTree;
begin
  {v0.72}
  Result := TULObjUsrTree.Create;
  {/v0.72
  if FULRootTree = nil then begin
    FULRootTree := TULObjUsrTree.Create;
  end;
  Result := TULObjUsrTree(FULRootTree);}
end;

{TULObjUsrTree}
constructor TULObjUsrTree.Create;
{v0.64}{/v0.64 var
  o: TULObj;
  i: integer;  }
begin
  inherited Create(nil, nil, 0);
  {v0.72}
  if FULRootTrees = nil then begin
    FULRootTrees := TList.Create;
  end;
  FULRootTrees.Add(Self);
  {/v0.72}

  FULFFiles := LinkAdd(nil, nnULFFiles);
  {v0.62}
  FilesUpdate;
  {/v0.62
  for i := 0 to ULFKeeper.Count - 1 do begin
    o := TULObj(ULFKeeper.Items[i]);
    FULFFiles.LinkAdd(o, o.FileName);
  end;
  }

end;

{v0.62}
procedure TULObjUsrTree.ObjUpdated;
begin
  if InDestroy then
    exit;
  FilesUpdate;
  inherited;
end;
{/v0.62}

{v0.64}
class function TULObjUsrTree.GetClassRecID: TULRecID;
begin
  Result := 0;
end;
{/v0.64}

procedure TULObjUsrTree.FilesUpdate;

  function HasFile(o: TULObj): boolean;
  var i: integer;
  begin
    Result := false;
    for i := 0 to FULFFiles.ChildCount - 1 do begin
      if FULFFiles.Childs[i].Obj = o then begin
        Result := true;
        exit;
      end;
    end;
  end;
var
  i: integer;
  o: TULObj;
  modi: boolean;
begin
  if FULFFiles = nil then
    exit;
  modi := false;
  for i := 0 to ULFKeeper.Count - 1 do begin
    o := TULObj(ULFKeeper.Items[i]);
    if not HasFile(o) then begin
      FULFFiles.LinkAdd(o, o.FileName);
      modi := true;
    end;
  end;
  if modi then
    FULFFiles.ObjUpdated;
end;

{v0.72}
destructor TULObjUsrTree.Destroy;
var i: integer;
begin
  if FULRootTrees <> nil then begin
    i := FULRootTrees.IndexOf(Self);
    if i >= 0 then
      FULRootTrees.Delete(i);
  end;
  inherited;
end;
{/v0.72}

{function TULObjUsrTree.GetActiveChannel: TULObj;
begin
  FindByULObjPath(nnActiveChannel, foDefault, Result);
end;

procedure TULObjUsrTree.SetActiveChannel(AObj: TULObj);
var n: TULObjUsrNode;
begin
  n := LinkAdd(AObj, nnActiveChannel);
end;}

{/TULObjUsrTree.}

{TULObjUsrNode}

function TULObjUsrNode.ChildCreate(AChildObj: TULObj): TULObjUsr;
begin
  if AChildObj <> nil then
    Result := TULObjUsrNode.Create(Self, AChildObj, AChildObj.RecID)
  else
    Result := TULObjUsrNode.Create(Self, nil, 0);
end;

function TULObjUsrNode.GetCaption: string;
begin
  if LinkName <> '' then
    Result := LinkName
  else
    Result := inherited GetCaption;
end;

function TULObjUsrNode.GetRecID: TULRecID;
begin
  if Obj <> nil then
    Result := Obj.RecID
  else
    Result := 0;
end;

{
function TULObjUsrNode.LinkFind(const ALinkName: string; var ANode: TULObjUsrNode): boolean;
begin
  for i := 0 to
end;
}

function TULObjUsrNode.LinkAdd(AChildObj: TULObj; const ALinkName: string): TULObjUsrNode;
begin
  Result := TULObjUsrNode(ChildAdd(AChildObj, 0, ''));
  Result.LinkName := ALinkName;
end;

procedure TULObjUsrNode.ChildsUpdate;
var
  o: TULObj;
  i: integer;
  ou: TULObjUsr;
begin
  if Obj = nil then
    exit;
  for i := 0 to Obj.ChildCount - 1 do begin
    o := TULObj(Obj.Childs[i]);
    if not ChildFind(o, ou) then
      ChildAdd(o, 0, '');
  end;
  {v0.64}
  i := 0;
  while i < ChildCount do begin
    ou := Childs[i];
    if (TULObjUsrNode(ou).LinkName = '') and (Obj.ChildList.IndexOf(ou.Obj) < 0) then
      ou.Free
    else
      inc(i);
  end;
  {/v0.64
  for i := 0 to ChildCount - 1 do begin
    ou := Childs[i];
    if (TULObjUsrNode(ou).LinkName = '') and (Obj.ChildList.IndexOf(ou.Obj) < 0) then
      ou.Free;
  end;
  }
end;

{v0.62}
destructor TULObjUsrNode.Destroy;
begin
  InDestroy := true;
  TreeNodesRelease;
  inherited;
end;

procedure TULObjUsrNode.ObjUpdated;
var
  t: TTreeNode;
  i: integer;
begin
  if InDestroy then
    exit;
  inherited;
  if FTreeNodes <> nil then begin
    for i := 0 to FTreeNodes.Count - 1 do begin
      t := TTreeNode(FTreeNodes[i]);
      t.Text := Caption;
      TreeNodeUpdateChilds(t);
    end;
  end;
end;

procedure TULObjUsrNode.TreeNodesRelease;
var
  t: TTreeNode;
  i: integer;
begin
  if FTreeNodes <> nil then begin
    for i := 0 to FTreeNodes.Count - 1 do begin
      t := TTreeNode(FTreeNodes[i]);
      t.Delete;
    end;
  end;
  FTreeNodes.Free;    {ttreenode}
  FTreeNodes := nil;
end;

function TULObjUsrNode.TreeNodes: TList;
begin
  if FTreeNodes = nil then
    FTreeNodes := TList.Create;
  Result := FTreeNodes;
end;

procedure TULObjUsrNode.TreeNodeRegister(ATreeNode: pointer);
begin
  TreeNodes.Add(ATreeNode);
end;

procedure TULObjUsrNode.TreeNodeUnregister(ATreeNode: pointer);
var i: integer;
begin
  i := TreeNodes.IndexOf(ATreeNode);
  if i >= 0 then
    TreeNodes.Delete(i)
  else
    LogErr('TreeNodeUnregister mismatch');
end;
{/v0.62}
{v0.67}
class function TULObjUsrNode.GetClassRecID: TULRecID;
begin
  Result := 0;
end;
{/v0.67}

(*
function TULObjUsrNode.FindByULObjPath(const AULObjPath: string; fo:TULRecFindOptions;
   var AObj: TULObj): boolean;
{
  Search for AObj in the whole ULObjs tree (including other files).

  Syntax for AULObjPath:

   [ /[::file="filename"] | .. ]
   [[[RecIDStrX:][[PropNameX=]"PropValueX"]].][[RecIDStr:][[PropName2=]"PropValue2"]]
   ...

  if starts with / search will start from all registered ULFObj file roots
    (if file name specified, then only in this file used), will scan the file(s)
    until something found or failed

  if does not start with /, then the object itself and its childs will be
  searched

  if starts with .. search will be started from the objects's owner

  if RecIDStrX: specified, and the Obj has this RecID, then the info for this
    RecID will be stripped off and the remaining path will be submitted to childs
   (and childs of childs, ..). If no remaining path, checked this obj for match.

  If RecIDStrX not specified, than path will be stripped only if property
  name and value match found in this ULObj.  Otherwise unmodified path will
  be submited to childs.

  If PropName will be omitted, than the name of the field that will be checked
  for the specified value will be taken from ObjDesc.NameProp (if not specified
  there, TComponent.Name is used if the object has not rfHasRecName set, otherwise
  the first ULObj indexed field (that is RecName) is used.)

  Values must be specified in quotes if contain spaces, dots, slahes, colons, etc.
}

var
  idStr, pName, pValue, rest,
  tValue: string;
  {id:TULRecID;}
  i: integer;
  inQ: boolean;{, valueFound: boolean;}
  ch: char;
  f:TULObjField;

  function Cut: string;
  begin
    Result := copy(rest, 1, i - 1);
    rest := copy(rest, i + 1, length(rest));
    i := 0;
  end;

  function ScanChilds(const APath:string): boolean;
  var
    i: integer;
  begin
    Result := false;
    for i := 0 to ChildCount - 1 do begin
      if Childs[i].FindByULObjPath(APath, fo, AObj) then begin
        Result := true;
        exit;
      end;
    end;
  end;

begin
  Result := false;
  if AULObjPath = '' then
    exit;
  if AULObjPath[1] = '/' then begin

    Result := TopOwner.FindByULObjPath(copy(AULObjPath, 2, length(AULObjPath)), fo, AObj)

  end else if (length(AULObjPath) > 1) and (copy(AULObjPath, 1, 2) = '..') then begin

    if ULObjOwner <> nil then begin
      Result := ULObjOwner.FindByULObjPath(copy(AULObjPath, 3, length(AULObjPath)), fo, AObj);
    end else
      SetResult(orNonULObjOwner, AULObjPath);

  end else begin

    inQ := false;
    idStr := '';
    pName := '';
    pValue := '';
    rest := AULObjPath;
    i := 1;
    while i <= length(rest) do begin
      ch := rest[i];
      if not inQ then begin
        case ch of
          ':': begin
            idStr := Cut
          end;
          '=': begin
            pName := Cut;
          end;
          '"': begin
            inQ := true;
            if i <> 1 then begin
              SetResult(orMisplacedQuoteInFindByULPath, rest);{ulrectyp}
            end;
            Cut;
          end;
          '.': begin
            pValue := Cut;
            break;
          end;
        end
      end else begin
        if ch = '"' then begin
          {$HINTS OFF}
          inQ := false;
          {$HINTS ON}
          pValue := Cut;
          if rest <> '' then begin
            if rest[1] <> '.' then begin
              SetResult(orDotMissingInULPath, rest);
            end;
            rest := copy(rest, 2, length(rest));
          end;
          break;
        end;
      end;
      inc(i);
    end;

    if idStr <> '' then begin

      if (idStr = ULRecIDToStrStrip(RecID)) then begin

        if pName = '' then begin

          if pValue = '' then begin
            if rest <> '' then begin
              pValue := rest;
              rest := '';
            end;
          end;

          if pValue = '' then begin
            if rest <> '' then begin
              Result := ScanChilds(rest);
              exit;
            end else begin
              AObj := Obj;
              Result := true;
              exit;
            end;
          end else begin

            if Obj <> nil then
              pName := Obj.ObjDesc.EfNameProp

          end;
        end;

        if pValue = '' then begin
          pValue := rest;
          rest := '';
        end;

        if pName <> '' then begin
          f := FindField(pName);
          tValue := f.AsUsrString;
        end else begin
          tValue := LinkName;
        end;

        if (tValue = pValue) or (pValue = '') then begin
          if rest = '' then begin
            AObj := Self;
            Result := true;
            exit;
          end else begin
            Result := ScanChilds(rest);
          end;
        end;

      end else begin
        Result := ScanChilds(AULObjPath);
      end;

    end else begin
      {idStr = ''}
      if pName = '' then begin

        if pValue = '' then begin
          pValue := rest;
          rest := '';
        end;
        if pValue = '' then begin
          Result := ScanChilds(AULObjPath);
          exit;
        end;
        pName := ObjDesc.EfNameProp;
        if pName = 'Name' then begin
          tValue := Name;
        end else begin
          tValue := FindField(pName).AsUsrString;
        end;
        if tValue <> pValue then
          Result := ScanChilds(AULObjPath)
        else begin
          if rest <> '' then
            Result := ScanChilds(rest)
          else begin
            AObj := Self;
            Result := true;
          end;
        end;

      end else begin

        if pName = 'Name' then begin
          tValue := Name;
        end else begin
          tValue := FindField(pName).AsUsrString;
        end;
        if tValue <> pValue then begin
          Result := false;
          exit;
        end else begin
          if rest <> '' then begin
            Result := ScanChilds(rest);
          end else begin
            AObj := Self;
            Result := true;
          end;
        end;

      end;

    end;

  end;
end;
*)

end.
