{
   Double Commander
   -------------------------------------------------------------------------
   Load colors of files in file panels

   Copyright (C) 2003-2004 Radek Cervinka (radek.cervinka@centrum.cz)
   Copyright (C) 2006-2017 Alexander Koblov (alexx2000@mail.ru)
   Copyright (C) 2008  Dmitry Kolomiets (B4rr4cuda@rambler.ru)

   This program 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.

   This program 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 this program; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   
}

unit uColorExt;

{$mode objfpc}{$H+}

interface

uses
  Classes, Graphics, uFile, uMasks, DCXmlConfig;

type

  { TMaskItem }

  TMaskItem = class
  private
    FExt: String;
    FMaskList: TMaskList;
    procedure SetExt(const AValue: String);
  public
    sName: String;
    sModeStr: String;
    cColor: TColor;

    constructor Create;
    destructor Destroy; override;

    procedure Assign(ASource: TMaskItem);
    property sExt: String read FExt write SetExt;
  end;

  { TColorExt }

  TColorExt = class
  private
    lslist: TList;

    function GetCount: Integer;
    function GetItems(const Index: Integer): TMaskItem;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Clear;
    procedure Add(AItem: TMaskItem);

    function GetColorByExt(const sExt: String): TColor;
    function GetColorByAttr(const sModeStr: String): TColor;
    function GetColorBy(const AFile: TFile): TColor;
    procedure Load(AConfig: TXmlConfig; ANode: TXmlNode);
    procedure Save(AConfig: TXmlConfig; ANode: TXmlNode);

    property Count: Integer read GetCount;
    property Items[const Index: Integer]: TMaskItem read GetItems; default;
  end;

implementation

uses
  SysUtils, uDebug, uGlobs, uFileProperty;

{ TMaskItem }

procedure TMaskItem.SetExt(const AValue: String);
begin
  FExt:= AValue;
  FreeAndNil(FMaskList);
  FMaskList:= TMaskList.Create(FExt);
end;

constructor TMaskItem.Create;
begin
  FMaskList:= TMaskList.Create(FExt);
end;

destructor TMaskItem.Destroy;
begin
  FreeAndNil(FMaskList);
  inherited Destroy;
end;

procedure TMaskItem.Assign(ASource: TMaskItem);
begin
  Assert(Assigned(ASource));
  sExt := ASource.sExt;
  sModeStr := ASource.sModeStr;
  cColor := ASource.cColor;
  sName := ASource.sName;
end;

function TColorExt.GetCount: Integer;
begin
  Result := lslist.Count;
end;

function TColorExt.GetItems(const Index: Integer): TMaskItem;
begin
  Result := TMaskItem(lslist[Index]);
end;

constructor TColorExt.Create;
begin
  inherited;
  lslist:= TList.Create;
end;

destructor TColorExt.Destroy;
begin
  Clear;
  FreeAndNil(lsList);
  inherited;
end;

procedure TColorExt.Clear;
begin
  while lslist.Count > 0 do
    begin
      TMaskItem(lslist[0]).Free;
      lslist.Delete(0);
    end;
end;

procedure TColorExt.Add(AItem: TMaskItem);
begin
  lslist.Add(AItem);
end;

function TColorExt.GetColorByExt(const sExt: String): TColor;
var
  I: Integer;
begin
  Result:= clDefault;
  for I:=0 to lslist.Count-1 do
  begin
    if MatchesMaskList(sExt, TMaskItem(lslist[I]).sExt,';') then
    begin
      Result:= TMaskItem(lslist[I]).cColor;
      Exit;
    end;
  end;
end;

function TColorExt.GetColorByAttr(const sModeStr: String): TColor;
var
  I: Integer;
begin
  Result:= clDefault;
  for I:=0 to lslist.Count-1 do
  begin
    if MatchesMaskList(sModeStr,TMAskItem(lslist[I]).sModeStr,';') then
    begin
      Result:=TMAskItem(lslist[I]).cColor;
      Exit;
    end;
  end;
end;

function TColorExt.GetColorBy(const AFile: TFile): TColor;
var
  Attr: String;
  I, J: Integer;
  MaskItem: TMaskItem;
begin
  Result:= clDefault;
  if not (fpAttributes in AFile.SupportedProperties) then
    Attr:= EmptyStr
  else begin
    Attr:= AFile.Properties[fpAttributes].AsString;
  end;
  for I:= 0 to lslist.Count-1 do
  begin
    MaskItem:= TMaskItem(lslist[I]);

    // Get color by search template
    if MaskItem.sExt[1] = '>' then
    begin
      for J:= 0 to gSearchTemplateList.Count - 1 do
        with gSearchTemplateList do
        begin
          if (Templates[J].TemplateName = PChar(MaskItem.sExt)+1) and
             Templates[J].CheckFile(AFile) then
            begin
              Result:= MaskItem.cColor;
              Exit;
            end;
        end;
      Continue;
    end;

    // Get color by extension and attribute.
    // If attributes field is empty then don't match directories.
    if ((MaskItem.sExt = '') or
         (((MaskItem.sModeStr <> '') or
           not (AFile.IsDirectory or AFile.IsLinkToDirectory)) and
          MaskItem.FMaskList.Matches(AFile.Name)))
       and
       ((MaskItem.sModeStr = '') or (Length(Attr) = 0) or
         MatchesMaskList(Attr, MaskItem.sModeStr, ';')) then
      begin
        Result:= MaskItem.cColor;
        Exit;
      end;
  end;
end;

(* Load colors of files from doublecmd.ini *)

{  format of colors storage as in Total Commander:
   doublecmd.ini
     [Colors]
     ColorFilter1=*.o;*.ppu;*.rst;*.bak;*.dcu
     ColorFilter1Color=16711680
     ColorFilter2=*.pas
     ColorFilter2Color=16711000
   etc...

Added Attributes:
 ColorFilter1Attributes=-r*xr*xr*x     //all read/executable file
 ColorFilter2Attributes=-*x*   //all executable
 ColorFilter3Attributes=d*     //all directories
 ColorFilter4Attributes=l*     //all links

 Be careful with * expression. Functions return just first found value.
 
 This is right demo of [Colors] section:
 ColorFilter3=*
 ColorFilter3Color=55758
 ColorFilter3Attributes=-rwxrwxr*x
 ColorFilter3Name=SomeName3
 ColorFilter4=*
 ColorFilter4Color=32768
 ColorFilter4Attributes=-*x*
 ColorFilter4Name=SomeName4

 This IS WRONG because ColorFilter3Attributes=-*x* will be
 found and ColorFilter3Color=32768 will be returned first:
 ColorFilter3=*
 ColorFilter3Color=32768
 ColorFilter3Attributes=-*x*
 ColorFilter3Name=SomeName3
 ColorFilter4=*
 ColorFilter4Color=55758
 ColorFilter4Attributes=-rwxrwxr*x
 ColorFilter4Name=SomeName4
 

!!! The "?" and other regular expressions DOES NOT SUPPORTED

}

procedure TColorExt.Load(AConfig: TXmlConfig; ANode: TXmlNode);
var
  sExtMask,
  sAttr,
  sName: String;
  iColor: Integer;
begin
  Clear;

  ANode := ANode.FindNode('FileFilters');
  if Assigned(ANode) then
  begin
    ANode := ANode.FirstChild;
    while Assigned(ANode) do
    begin
      if ANode.CompareName('Filter') = 0 then
      begin
        if AConfig.TryGetValue(ANode, 'Name', sName) and
           AConfig.TryGetValue(ANode, 'FileMasks', sExtMask) and
           AConfig.TryGetValue(ANode, 'Color', iColor) and
           AConfig.TryGetValue(ANode, 'Attributes', sAttr) then
        begin
          lsList.Add(TMaskItem.Create);
          TMaskItem(lsList.Last).sName    := sName;
          TMaskItem(lsList.Last).cColor   := iColor;
          TMaskItem(lsList.Last).sExt     := sExtMask;
          TMaskItem(lsList.Last).sModeStr := sAttr;
        end
        else
        begin
          DCDebug('Invalid entry in configuration: ' + AConfig.GetPathFromNode(ANode) + '.');
        end;
      end;
      ANode := ANode.NextSibling;
    end;
  end;
end;

procedure TColorExt.Save(AConfig: TXmlConfig; ANode: TXmlNode);
var
  I : Integer;
  SubNode: TXmlNode;
begin
  if not Assigned(lslist) then
    Exit;

  ANode := AConfig.FindNode(ANode, 'FileFilters', True);
  AConfig.ClearNode(ANode);

  for I:=0 to lslist.Count - 1 do
    begin
      SubNode := AConfig.AddNode(ANode, 'Filter');
      AConfig.AddValue(SubNode, 'Name', TMaskItem(lsList[I]).sName);
      AConfig.AddValue(SubNode, 'FileMasks', TMaskItem(lsList[I]).sExt);
      AConfig.AddValue(SubNode, 'Color', TMaskItem(lsList[I]).cColor);
      AConfig.AddValue(SubNode, 'Attributes', TMaskItem(lsList[I]).sModeStr);
    end;
end;

end.
