libTextSuite/src/ultsContext.pas

unit ultsContext;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  utsTextSuite, utsUtils,
  ultsTypes;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TltsContext = class(TtsContext)
  public
    function DelSlave(const aSlave: TtsRefManager): Boolean; override;
  end;

  function ltsContextCreate         ():                                                               TltsContextHandle;  stdcall;
  function ltsContextGetCodePage    (const aHandle: TltsContextHandle; out aCodePage: TtsCodePage):   TltsErrorCode;      stdcall;
  function ltsContextGetDefaultChar (const aHandle: TltsContextHandle; out aValue: WideChar):         TltsErrorCode;      stdcall;
  function ltsContextSetCodePage    (const aHandle: TltsContextHandle; aCodePage: TtsCodePage):       TltsErrorCode;      stdcall;
  function ltsContextSetDefaultChar (const aHandle: TltsContextHandle; aValue: WideChar):             TltsErrorCode;      stdcall;
  function ltsContextAnsiToWide     (const aHandle: TltsContextHandle; aText: PAnsiChar):             PWideChar;          stdcall;
  function ltsContextDestroy        (const aHandle: TltsContextHandle):                               TltsErrorCode;      stdcall;

implementation

uses
  ultsUtils {$IFDEF DEBUG}, uutlLogger{$ENDIF};

var
  WideStringBuffer: WideString;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TltsContext///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TltsContext.DelSlave(const aSlave: TtsRefManager): Boolean;
begin
  DelReference(aSlave);
  result := inherited DelSlave(aSlave);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Context///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextCreate: TltsContextHandle; stdcall;
var
  c: TltsContext;
begin
  try
    result := nil;
    if not CheckIfInitialized then
      exit;
    c := TltsContext.Create;
    AddReference(ltsObjTypeContext, c);
    result := c;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextCreate=%p', [result]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextGetCodePage(const aHandle: TltsContextHandle; out aCodePage: TtsCodePage): TltsErrorCode; stdcall;
var
  c: TtsContext;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextGetCodePage(Handle=%p; aCodePage=%p)', [aHandle, @aCodePage]);{$ENDIF}
    result := ltsErrNone;
    if CheckContextHandle(aHandle, c)
      then aCodePage := c.CodePage
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextGetCodePage=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextGetDefaultChar(const aHandle: TltsContextHandle; out aValue: WideChar): TltsErrorCode; stdcall;
var
  c: TtsContext;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextGetDefaultChar(Handle=%p; aValue=%p)', [aHandle, @aValue]);{$ENDIF}
    result := ltsErrNone;
    if CheckContextHandle(aHandle, c)
      then aValue := c.DefaultChar
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextGetDefaultChar=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextSetCodePage(const aHandle: TltsContextHandle; aCodePage: TtsCodePage): TltsErrorCode; stdcall;
var
  c: TtsContext;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextSetCodePage(Handle=%p; aCodePage=%d)', [aHandle, Integer(aCodePage)]);{$ENDIF}
    result := ltsErrNone;
    if CheckContextHandle(aHandle, c) then begin
      if not ValidateCodePage(aCodePage) then begin
        SetLastError(ltsErrInvalidEnum, Format('%d is not a valid enum value for CodePage', [aCodePage]));
        result := LastErrorCode;
      end else
        c.CodePage := aCodePage;
    end else
      result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextSetCodePage=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextSetDefaultChar(const aHandle: TltsContextHandle; aValue: WideChar): TltsErrorCode; stdcall;
var
  c: TtsContext;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextSetDefaultChar(Handle=%p; aValue=%d)', [aHandle, Integer(aValue)]);{$ENDIF}
    result := ltsErrNone;
    if CheckContextHandle(aHandle, c)
      then c.DefaultChar := aValue
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextSetDefaultChar=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextAnsiToWide(const aHandle: TltsContextHandle; aText: PAnsiChar): PWideChar; stdcall;
var
  c: TtsContext;
  w: PWideChar;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextAnsiToWide(Handle=%p; aText=%p)', [aHandle, aText]);{$ENDIF}
    result := nil;
    if CheckContextHandle(aHandle, c) then begin
      w := c.AnsiToWide(aText);
      if not Assigned(w) then
        exit;
      WideStringBuffer := w;
      tsStrDispose(w);
      result := PWideChar(WideStringBuffer);
    end else
      result := nil;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextAnsiToWide=%p', [result]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextDestroy(const aHandle: TltsContextHandle): TltsErrorCode; stdcall;
var
  c: TtsContext;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextDestroy(Handle=%p)', [aHandle]);{$ENDIF}
    result := ltsErrNone;
    if CheckContextHandle(aHandle, c)
      then DelReference(ltsObjTypeContext, c)
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextDestroy=%d', [Integer(result)]);{$ENDIF}
end;

end.