RnQ/RnQ/SpellCheck.pas

{
  This file is part of R&Q.
  Under same license
}
unit SpellCheck;
{$I RnQConfig.inc}

interface

uses
  Winapi.Windows, Winapi.ActiveX, System.SysUtils, System.Types, System.Classes, System.Character, System.StrUtils, System.Variants,
  Generics.Collections, MsSpellCheckLib_TLB;

{$I NoRTTI.inc}

  procedure DoInitSpellCheck;
  procedure DoSpellCheck;
  procedure StopSpellTask;
  procedure CreateThreading;
  procedure ReleaseThreading;
  procedure SetSpellText(const txt: String);
  function SpellTextChanged(const txt: String): Boolean;
  function GetSuggestions(const word: String): Variant;

implementation

uses
  SciterLib, GlobalLib, RQUtil;

const
  CLSID_StdGlobalInterfaceTable: TGUID = '{00000323-0000-0000-C000-000000000046}';

var
  spellLangs: TList = nil;
  spellGIT: IGlobalInterfaceTable = nil;
  spellTask: TAnonTask = nil;
  spellText, spellTextFull: String;

procedure CreateThreading;
begin
  CoCreateInstance(CLSID_StdGlobalInterfaceTable, nil, CLSCTX_INPROC_SERVER, IGlobalInterfaceTable, spellGIT);
end;

procedure ReleaseThreading;
begin
  FreeAndNil(spellLangs);
end;

procedure SetSpellText(const txt: String);
var
  chr: Char;
  i, delim: Integer;
begin
  i := 0; delim := 0;
  // Skip unfinished word in the end
  for chr in ReverseString(txt) do
  begin
    Inc(i);
    if chr.IsSeparator or chr.IsPunctuation or chr.IsWhiteSpace then
    begin
      delim := i;
      Break;
    end;
  end;
  if delim > 0 then
    spellText := Copy(txt, 1, Length(txt) - delim)
  else
    spellText := '';
  spellTextFull := txt;
end;

function SpellTextChanged(const txt: String): Boolean;
begin
  Result := AnsiCompareStr(spellTextFull, txt) <> 0;
end;

procedure DoInitSpellCheck;
var
  iscf: ISpellCheckerFactory;
  isc: ISpellChecker;
  lang: String;
  supported: Integer;
  cookie: DWORD;
begin
  if not Assigned(spellGIT) then
    Exit;

  if Assigned(spellLangs) then
    for cookie in spellLangs do
      spellGIT.RevokeInterfaceFromGlobal(cookie);
  FreeAndNil(spellLangs);

  if not EnableSpellCheck then
    Exit;

  spellLangs := TList.Create;
  iscf := nil;
  try
    iscf := CoSpellCheckerFactory.Create;
  except
    Exit;
  end;

  for lang in spellLanguages do
  begin
    supported := 0;
    iscf.IsSupported(PChar(lang), supported);
    if not (supported = 0) then
    begin
      isc := nil;
      iscf.CreateSpellChecker(PChar(lang), isc);
      if Assigned(isc) then
      begin
        spellGIT.RegisterInterfaceInGlobal(isc, ISpellChecker, cookie);
        if spellLanguageMain = lang then
          spellLangs.Insert(0, cookie)
        else
          spellLangs.Add(cookie);
      end;
    end;
  end;
end;

procedure DoSpellCheck;
begin
  if not EnableSpellCheck then
  begin
    if Assigned(UI.Chat) then
      UI.Chat.UpdateSpelling(Null);
    Exit;
  end;

  if Assigned(spellTask) then
    FreeAndNil(spellTask);

  spellTask := TAnonTask.Create(procedure

    function getErrData(spellErr: ISpellingError): Variant;
    var
      st, len: Cardinal;
    begin
      st := 0; len := 0;
      spellErr.Get_StartIndex(st);
      spellErr.Get_Length(len);
      Result := VarArrayCreate([0, 1], varVariant);
      Result[0] := st;
      Result[1] := len;
    end;

  var
    spellWrong: Variant;
    spellErrs: IEnumSpellingError;
    spellErr: ISpellingError;
    cookie: DWORD;
    checker: ISpellChecker;
    lngCnt: Integer;
    action: CORRECTIVE_ACTION;
    word: PChar;
    v: Variant;
    i: Integer;
//  Freq, StartCount, StopCount: Int64;
//  TimingSeconds: real;
  begin
    if TThread.Current.CheckTerminated then
      Exit;

    CoInitializeEx(nil, COINIT_MULTITHREADED);
//QueryPerformanceFrequency(Freq);
//Freq := Freq div 1000;
//QueryPerformanceCounter(StartCount);
    spellWrong := Null;
    lngCnt := 0;
    for cookie in spellLangs do
    begin
      if TThread.Current.CheckTerminated then
        Break;
      if lngCnt = 0 then
      begin
        spellErrs := nil;
        spellGIT.GetInterfaceFromGlobal(cookie, ISpellChecker, checker);
        checker.Check(PChar(spellText), spellErrs);

        if Assigned(spellErrs) then
        while spellErrs.Next(spellErr) = S_OK do
        if Assigned(spellErr) then
        begin
          action := CORRECTIVE_ACTION_NONE;
          spellErr.Get_CorrectiveAction(action);
          if action = CORRECTIVE_ACTION_GET_SUGGESTIONS then
          begin
            if VarIsNull(spellWrong) then
              spellWrong := VarArrayCreate([0, 0], varVariant)
            else
              VarArrayRedim(spellWrong, VarArrayHighBound(spellWrong, 1) + 1);
            VarArrayPut(spellWrong, getErrData(spellErr), [VarArrayHighBound(spellWrong, 1)]);
          end;
        end;
      end
        else
      begin
        if VarIsNull(spellWrong) then
          Continue;

        for i := VarArrayLowBound(spellWrong, 1) to VarArrayHighBound(spellWrong, 1) do
        begin
          v := VarArrayGet(spellWrong, [i]);
          word := PChar(Copy(spellText, Cardinal(v[0]) + 1, Cardinal(v[1])));
          spellErrs := nil;
          spellGIT.GetInterfaceFromGlobal(cookie, ISpellChecker, checker);
          checker.Check(word, spellErrs);
          if not Assigned(spellErrs) or not (spellErrs.Next(spellErr) = S_OK) then
            spellWrong[i] := Null;
        end;
      end;
      Inc(lngCnt);
    end;
//QueryPerformanceCounter(StopCount);
//TimingSeconds := (StopCount - StartCount) / Freq;
//OutputDebugString(PChar(floattostr(TimingSeconds)));
    if not TThread.Current.CheckTerminated then
    TThread.Synchronize(nil, procedure
    begin
      if Assigned(UI.Chat) then
        UI.Chat.UpdateSpelling(spellWrong);
    end);

    CoUninitialize;
  end);
  spellTask.Start;
end;

procedure StopSpellTask;
begin
  if Assigned(spellTask) then
    FreeAndNil(spellTask);
end;

function GetSuggestions(const word: String): Variant;
var
  suggest: PWideChar;
  cookie: DWORD;
  spellSuggest: IEnumString;
  fetched: LongWord;
  checker: ISpellChecker;
begin
  Result := Null;
  if not Assigned(spellGIT) or (Trim(word) = '') then
    Exit;

  for cookie in spellLangs do
  begin
    spellGIT.GetInterfaceFromGlobal(cookie, ISpellChecker, checker);
    checker.Suggest(PWideChar(word), spellSuggest);
    if Assigned(spellSuggest) then
    while spellSuggest.RemoteNext(1, suggest, fetched) = S_OK do
    begin
      if VarIsNull(Result) then
        Result := VarArrayCreate([0, 0], varVariant)
      else
        VarArrayRedim(Result, VarArrayHighBound(Result, 1) + 1);
      VarArrayPut(Result, String(suggest), [VarArrayHighBound(Result, 1)]);
    end;
  end;
end;

end.