spiegel-keyman/developer/src/tike/debug/Keyman.System.Debug.DebugCore.pas

{
 * Keyman is copyright (C) SIL International. MIT License.
 *
 * Wrapper for Keyman Core debug interfaces
}
unit Keyman.System.Debug.DebugCore;

interface

uses
  System.SysUtils,

  Keyman.System.KeymanCore,
  Keyman.System.KeymanCoreDebug;

type
  EDebugCore = class(Exception);

  TDebugCore = class
  private
    FKeyboard: pkm_kbp_keyboard;
    FState: pkm_kbp_state;
    class var KeymanCoreLoaded: Boolean;
    class procedure InitKeymanCore; static;
    function GetKMXPlatform: string;
    procedure SetKMXPlatform(const Value: string);
  public
    constructor Create(const Filename: string; EnableDebug: Boolean);
    destructor Destroy; override;
    function GetOption(const name: string): string;
    procedure SetOption(const name, value: string);
    property KMXPlatform: string read GetKMXPlatform write SetKMXPlatform;
    property Keyboard: pkm_kbp_keyboard read FKeyboard;
    property State: pkm_kbp_state read FState;
  end;

implementation

uses
  KeymanPaths;

{ TDebugCore }

constructor TDebugCore.Create(const Filename: string; EnableDebug: Boolean);
var
  status: km_kbp_status;
begin
  inherited Create;

  InitKeymanCore;

  FKeyboard := nil;
  FState := nil;

  status := km_kbp_keyboard_load(PChar(FileName), FKeyboard);
  if status <> KM_KBP_STATUS_OK then
    raise EDebugCore.CreateFmt('Unable to start debugger -- keyboard load failed with error %x', [Ord(status)]);

  status := km_kbp_state_create(FKeyboard, @KM_KBP_OPTIONS_END, FState);
  if status <> KM_KBP_STATUS_OK then
    raise EDebugCore.CreateFmt('Unable to start debugger -- state creation failed with error %x', [Ord(status)]);

  if EnableDebug then
  begin
    status := km_kbp_state_debug_set(FState, 1);
    if status <> KM_KBP_STATUS_OK then
      raise EDebugCore.CreateFmt('Unable to start debugger -- enabling debug failed with error %x', [Ord(status)]);
  end;
end;

destructor TDebugCore.Destroy;
begin
  if FState <> nil then
    km_kbp_state_dispose(FState);
  FState := nil;
  if FKeyboard <> nil then
    km_kbp_keyboard_dispose(FKeyboard);
  FKeyboard := nil;
  inherited Destroy;
end;

class procedure TDebugCore.InitKeymanCore;
var
  path: string;
begin
  if not KeymanCoreLoaded then
  begin
    path := TKeymanPaths.KeymanCoreLibraryPath(kmnkbp0);
    try
      _km_kbp_set_library_path(path);
    except
      on E:Exception do
        raise EDebugCore.CreateFmt('Unable to load Keyman Core library at %s: %s %s', [path, E.ClassName, E.Message]);
    end;
    KeymanCoreLoaded := True;
  end;
end;

function TDebugCore.GetKMXPlatform: string;
var
  p: pkm_kbp_cp;
  status: km_kbp_status;
begin
  status := km_kbp_state_option_lookup(
    FState,
    KM_KBP_OPT_ENVIRONMENT,
    pkm_kbp_cp(PWideChar(KM_KBP_KMX_ENV_PLATFORM)),
    p
  );
  if status <> KM_KBP_STATUS_OK then
    raise EDebugCore.CreateFmt('Unable to locate platform, error %x', [Ord(status)]);
  Result := PWideChar(p);
end;

procedure TDebugCore.SetKMXPlatform(const Value: string);
var
  options: array[0..1] of km_kbp_option_item;
  status: km_kbp_status;
begin
  options[0].key := pkm_kbp_cp(PWideChar(KM_KBP_KMX_ENV_PLATFORM));
  options[0].value := pkm_kbp_cp(PWideChar(Value));
  options[0].scope := KM_KBP_OPT_ENVIRONMENT;
  options[1] := KM_KBP_OPTIONS_END;
  status := km_kbp_state_options_update(FState, @options[0]);
  if status <> KM_KBP_STATUS_OK then
    raise EDebugCore.CreateFmt('Unable to set platform, error %x', [Ord(status)]);
end;

function TDebugCore.GetOption(const name: string): string;
var
  p: pkm_kbp_cp;
  status: km_kbp_status;
begin
  status := km_kbp_state_option_lookup(
    FState,
    KM_KBP_OPT_KEYBOARD,
    pkm_kbp_cp(PWideChar(name)),
    p
  );
  if status <> KM_KBP_STATUS_OK then
    raise EDebugCore.CreateFmt('Unable to locate option %s, error %x', [name, Ord(status)]);
  Result := PWideChar(p);
end;

procedure TDebugCore.SetOption(const name, value: string);
var
  options: array[0..1] of km_kbp_option_item;
  status: km_kbp_status;
begin
  options[0].key := pkm_kbp_cp(PWideChar(Name));
  options[0].value := pkm_kbp_cp(PWideChar(Value));
  options[0].scope := KM_KBP_OPT_KEYBOARD;
  options[1] := KM_KBP_OPTIONS_END;
  status := km_kbp_state_options_update(FState, @options[0]);
  if status <> KM_KBP_STATUS_OK then
    raise EDebugCore.CreateFmt('Unable to set option %s, error %x', [name, Ord(status)]);
end;

end.