unit uLocalMgr;

//////////////////////////////////////
///  Lina Localize Manager Unit    ///
///  ****************************  ///
///  (c) 2014 Dennis Göhlert a.o.  ///
//////////////////////////////////////

interface

uses
  { Standard-Units }
  SysUtils, Classes, Windows,
  { Andere Package-Units }
  uBase, uSysTools;

type
  { Fehlermeldungen }
  EInvalidFormat = class(Exception);
  ELanguageTagExists = class(Exception);
  ELocalizationParse = class(Exception);

type
  { Hilfsklassen }
  TLanguageTag = String[3];
  TComponentDetectMode = (cdTag,cdName);
  TCommentAllow = type TLinePosition;

type
  { Hauptklassen }
  TLocalizationFormat = class(TPersistent)
  private
    { Private-Deklarationen }
    FAllowComment: TCommentAllow;
    FComment: ShortString;
    FSeparator: ShortString;
    FHeader: ShortString;
    FIndent: ShortString;
    { Methoden }
    procedure SetComment(Value: ShortString);
    procedure SetSeparator(Value: ShortString);
    procedure SetHeader(Value: ShortString);
    procedure SetIndent(Value: ShortString);
  public
    { Public-Deklarationen }
    constructor Create;
    destructor Destroy; override;
  published
    { Published-Deklarationen }
    property AllowComment: TCommentAllow read FAllowComment write FAllowComment default lpAnyPosition;
    property Comment: ShortString read FComment write SetComment;         //nicht leer
    property Separator: ShortString read FSeparator write SetSeparator;   //nicht leer
    property Header: ShortString read FHeader write SetHeader;
    property Indent: ShortString read FIndent write SetIndent;
  end;

  TLocalization = class(TCollectionItem)
  private
    { Private-Deklarationen }
    FName: ShortString;
    FLines: TStrings;
    FTag: TLanguageTag;
    FFormat: TLocalizationFormat;
    { Methoden }
    function GetLines: TStrings;
    procedure SetLines(Value: TStrings);
    procedure SetTag(Value: TLanguageTag);
    function GetFormat: TLocalizationFormat;
    procedure SetFormat(Value: TLocalizationFormat);
  protected
    { Protected-Deklarationen }
    procedure RaiseParseError(Msg: String; LineIndex, CharIndex: Integer);
  public
    { Public-Deklarationen }
    constructor Create(Collection: TCollection); overload; override;
    constructor Create(Collection: TCollection; const AFileName: TFileName); overload;
    destructor Destroy; override;
    //function Check: Boolean; overload;
    //function Check(const Line: Integer): Boolean; overload;
    procedure Apply;
  published
    { Published-Deklarationen }
    property Name: ShortString read FName write FName;
    property Tag: TLanguageTag read FTag write SetTag;
    property Lines: TStrings read GetLines write SetLines;
    property Format: TLocalizationFormat read GetFormat write FFormat;
  end;

  TLocalizationManager = class;

  TLocalizations = class(TCollection)
  private
    { Private-Deklarationen }
    FManager: TLocalizationManager;
    { Methoden }
    function GetManager: TLocalizationManager;
    procedure SetManager(Value: TLocalizationManager);
  public
    { Public-Deklarationen }
    constructor Create(ItemClass: TCollectionItemClass; AManager: TLocalizationManager);
    destructor Destroy; override;
    function IndexOfTag(const Tag: TLanguageTag): Integer;
    { Eigenschaften }
    property Manager: TLocalizationManager read FManager write FManager;
  end;

  TLocalizationManager = class(TComponent)
  private
    { Private-Deklarationen }
    FAbout: TComponentAbout;
    FLocalizations: TLocalizations;
    FCurrent: Integer;
    FDefault: Integer;
    FDetect: TComponentDetectMode;
    { Methoden }
    procedure SetCurrent(Value: Integer);
  protected
    { Protected-Deklarationen }
  public
    { Public-Deklarationen }
    constructor Create(AOwnder: TComponent); override;
    destructor Destroy; override;
  published
    { Published-Deklarationen }
    property About: TComponentAbout read FAbout;
    property Localizations: TLocalizations read FLocalizations write FLocalizations;
    property Current: Integer read FCurrent write SetCurrent default -1;
    property Default: Integer read FDefault write FDefault default -1;
    property Detect: TComponentDetectMode read FDetect write FDetect default cdName;
  end;

  procedure Register;

const
  { Meta-Daten }
  LocalizationManagerComponent_Name = 'LocalizationManager';
  LocalizationManagerComponent_Version = 1.0;
  LocalizationManagerComponent_Copyright = 'Copyright © 2014';
  LocalizationManagerComponent_Author = 'Dennis Göhlert a.o.';

implementation

procedure Register;
begin
  RegisterComponents(ComponentsPage,[TLocalizationManager]);
end;

{ ----------------------------------------------------------------------------
  TLocalizationFormat
  ---------------------------------------------------------------------------- }

constructor TLocalizationFormat.Create;
begin
  inherited;
  FAllowComment := lpAnyPosition;
  FComment := ';';
  FSeparator := '=';
  FHeader := '*';
end;

destructor TLocalizationFormat.Destroy;
begin
  //...
  inherited;
end;

procedure TLocalizationFormat.SetComment(Value: ShortString);
var
  Index: Integer;
begin
  if (ArrayPos(Value,[FSeparator,FHeader,FIndent]) <> -1) or (Length(Value) = 0) then
  begin
    raise EInvalidFormat.Create('Invalid param format for property: "Comment"');
  end;
  for Index := 1 to Length(Value) do
  begin
    if Value[Index] in Spaces then
    begin
      raise EInvalidFormat.Create('Invalid param format for property: "Comment"');
    end;
  end;
  FComment := Value;
end;

procedure TLocalizationFormat.SetSeparator(Value: ShortString);
var
  Index: Integer;
begin
  if (ArrayPos(Value,[FComment,FHeader,FIndent]) <> -1) or (Length(Value) = 0) then
  begin
    raise EInvalidFormat.Create('Invalid param format for property: "Separator"');
  end;
  for Index := 1 to Length(Value) do
  begin
    if Value[Index] in Spaces then
    begin
      raise EInvalidFormat.Create('Invalid param format for property: "Separator"');
    end;
  end;
  FSeparator := Value;
end;

procedure TLocalizationFormat.SetHeader(Value: ShortString);
var
  Index: Integer;
begin
  if ArrayPos(Value,[FComment,FSeparator,FIndent]) <> -1 then
  begin
    raise EInvalidFormat.Create('Invalid param format for property: "Header"');
  end;
  for Index := 1 to Length(Value) do
  begin
    if Value[Index] in Spaces then
    begin
      raise EInvalidFormat.Create('Invalid param format for property: "Header"');
    end;
  end;
  FHeader := Value;
end;

procedure TLocalizationFormat.SetIndent(Value: ShortString);
var
  Index: Integer;
begin
  if ArrayPos(Value,[FComment,FSeparator,FHeader]) <> -1 then
  begin
    raise EInvalidFormat.Create('Invalid param format for property: "Header"');
  end;
  for Index := 1 to Length(Value) do
  begin
    if Value[Index] in Spaces then
    begin
      raise EInvalidFormat.Create('Invalid param format for property: "Header"');
    end;
  end;
  FIndent := Value;
end;

{ ----------------------------------------------------------------------------
  TLocalization
  ---------------------------------------------------------------------------- }

constructor TLocalization.Create(Collection: TCollection);
begin
  inherited;
  FLines := TStringList.Create;
  FFormat := TLocalizationFormat.Create;
end;

constructor TLocalization.Create(Collection: TCollection; const AFileName: TFileName);
begin
  Create(Collection);
  Lines.LoadFromFile(AFileName);
end;

destructor TLocalization.Destroy;
begin
  FLines.Free;
  FFormat.Free;
  inherited;
end;

function TLocalization.GetLines: TStrings;
begin
  Result := FLines;
end;

procedure TLocalization.SetLines(Value: TStrings);
begin
  (FLines as TStringList).Assign(Value);
end;

procedure TLocalization.SetTag(Value: TLanguageTag);
begin
  if ((Collection as TLocalizations).IndexOfTag(Value) > -1) and
     ((Collection as TLocalizations).IndexOfTag(Value) <> Index)then
  begin
    raise ELanguageTagExists.Create('Language tag already exists');
  end else
  begin
    FTag := UpperCase(Value);
  end;
end;

function TLocalization.GetFormat: TLocalizationFormat;
begin
  Result := FFormat;
end;

procedure TLocalization.SetFormat(Value: TLocalizationFormat);
begin
  FFormat := Value;
end;

procedure TLocalization.RaiseParseError(Msg: String; LineIndex, CharIndex: Integer);
begin
  raise ELocalizationParse.Create('[' + IntToStr(LineIndex) + '.' + IntToStr(CharIndex) + ']' + ' ' + Msg);
end;

{function TLocalization.Apply(const Line: Integer): Boolean;
var
  Index: Integer;
  LineStr: String;
  InPart: array [3] of Byte; //0 = Header; 1 = Separator; 2 = Indent
begin
  Result := True;
  LineStr := Lines.Strings[Index];
  { Standardwerte }
 { InPart[0] := 0;
  InPart[1] := 0;
  InPart[2] := 0;
  { Parse }
 { for Index := 1 to Length(LineStr) do
  begin

    if LineStr[Index] in Spaces then
    begin
      Continue;
    end;
  end;
end;       }

procedure TLocalization.Apply;
var
  LineIndex: Integer;
  CharIndex: Integer;
  Line: String;
  Identifier: ShortString;
  Value: String;
  Expr: String;
  Header: Boolean;
  Position: (posPrefix,posIndent,posSeparator,posValue);
begin
  for LineIndex := 0 to Lines.Count - 1 do
  begin
    Line := Lines.Strings[LineIndex];
    for CharIndex := 1 to Length(Line) do
    begin
      if Expr = Format.Comment then
      begin

      end;
      if Line[CharIndex] in Spaces then
      begin
        case Position of
         //[>PRE<] Indent SEP Value
         posPrefix:

         //PRE [>Indent<] SEP Value
      //   posIndent: if Length(Expr then

         //PRE Indent [>SEP<] Value
    //     posSeparator: if Expr = Format.Separator then
                       begin
                         Position := posValue;
                         Continue;
                       end;
         //PRE Indent SEP [>Value<]
         posValue: Expr := Expr + Line[CharIndex];
        end;
      end;
    end;
    { Auf vollständigkeit prüfen... }
    case Position of
     posPrefix: RaiseParseError('Prefix expected, but end of line found',LineIndex,CharIndex);
     posIndent: if Header = True then
                begin
                  RaiseParseError('Header expected, but end of line found',LineIndex,CharIndex);
                end else
                begin
                  RaiseParseError('Indent expected, but end of line found',LineIndex,CharIndex);
                end;
     posSeparator: RaiseParseError('Definition expected, but end of line found',LineIndex,CharIndex);
    end;
  end;
  //--------------------------------
  (Collection as TLocalizations).Manager.FCurrent := Index;
end;

{ ----------------------------------------------------------------------------
  TLocalizations
  ---------------------------------------------------------------------------- }

constructor TLocalizations.Create(ItemClass: TCollectionItemClass; AManager: TLocalizationManager);
begin
  inherited Create(ItemClass);
  FManager := AManager;
end;

destructor TLocalizations.Destroy;
begin
  FManager := nil;
  inherited;
end;

function TLocalizations.GetManager: TLocalizationManager;
begin
  Result := FManager;
end;

procedure TLocalizations.SetManager(Value: TLocalizationManager);
begin
  FManager := Value;
end;

function TLocalizations.IndexOfTag(const Tag: TLanguageTag): Integer;
var
  Index: Integer;
begin
  Result := -1;
  for Index := 0 to Count - 1 do
  begin
    if (Items[Index] as TLocalization).Tag = UpperCase(Tag) then
    begin
      Result := Index;
      Exit;
    end;
  end;
end;

{ ----------------------------------------------------------------------------
  TLocalizationManager
  ---------------------------------------------------------------------------- }

constructor TLocalizationManager.Create(AOwnder: TComponent);
begin
  inherited;
  FAbout := TComponentAbout.Create(LocalizationManagerComponent_Name,LocalizationManagerComponent_Version,LocalizationManagerComponent_Copyright,LocalizationManagerComponent_Author);
  FLocalizations := TLocalizations.Create(TLocalization,Self);
  FDetect := cdName;
  FDefault := -1;
  //Aktuelle Loc = Standard-Loc
  Current := Default;
end;

destructor TLocalizationManager.Destroy;
begin
  FAbout.Free;
  FLocalizations.Free;
  inherited;
end;

procedure TLocalizationManager.SetCurrent(Value: Integer);
begin
  if Value > -1 then
  begin
    (Localizations.Items[Value] as TLocalization).Apply;
    //FCurrent wird in der Apply-Methode geändert...
  end else
  begin
    FCurrent := Value;
  end;
end;

end.
