////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// This unit implement UserHints.                                             //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20260705 - Created by A.K.                                                 //
////////////////////////////////////////////////////////////////////////////////

unit _crw_uhints; //  Unit for uhints.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math,
 _crw_alloc, _crw_ef, _crw_rtc, _crw_str, _crw_fio,
 _crw_hl, _crw_dbglog, _crw_lngid;

 {
 ///////////////////////////////////////////////////////////////////////////////
 UserHints is user defined hints loadable from file associated with string key.
 It's language-dependent and can be used for user interface: help, tooltip etc.
 Configuration is like next:
 [UserHints.Languages]
 Languages = en,ru
 []
 [UserHints.en]
 Name1 = Hint1
 ...
 []
 [UserHints.ru]
 Name1 = Hint1
 ...
 []
 ///////////////////////////////////////////////////////////////////////////////
 }
type
 TUserHintsList = class(TLatch)
 private
  myHintsList : THashList;
  myLanguages : LongString;
  function  GetCount:Integer;
  function  GetLanguages:LongString;
  procedure SetLanguages(arg:LongString);
  function  GetDefaultLanguages:LongString;
  function  GetPrimeLanguage:LongString;
  function  GetUserHints(const lng,key:LongString):LongString;
  procedure SetUserHints(const lng,key,val:LongString);
  function  GetHasUserHints(const lng,key:LongString):Boolean;
 public
  property Count:Integer read GetCount;
  property PrimeLanguage:LongString read GetPrimeLanguage;
  property DefaultLanguages:LongString read GetDefaultLanguages;
  property Languages:LongString read GetLanguages write SetLanguages;
  property UserHints[lng,key:LongString]:LongString read GetUserHints write SetUserHints; default;
  property HasUserHints[lng,key:LongString]:Boolean read GetHasUserHints;
 public
  constructor Create;
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public
  procedure Clear;
  function  ListAsText:LongString;
  function  ReadIni(Ini,Sec:LongString):Integer;
 end;

function SysUserHints:TUserHintsList;
function DaqUserHints:TUserHintsList;

function NewUserHintsList(const Ini:LongString='';
                          const Sec:LongString=''):TUserHintsList;
procedure Kill(var TheObject:TUserHintsList); overload;

 {
 FetchUserHints('-sys -list');
 FetchUserHints('-daq -list');
 FetchUserHints('-sys -ru demo_key');
 FetchUserHints('-daq -en demo_key');
 }
function FetchUserHints(const args:LongString; const def:LongString=''):LongString;

procedure Init_UserHintsSubsystem;
procedure Free_UserHintsSubsystem;


implementation

////////////////
// Help routines
////////////////

function NewUserHintsList(const Ini:LongString='';
                          const Sec:LongString=''):TUserHintsList;
begin
 Result:=nil;
 try
  Result:=TUserHintsList.Create;
  if (Ini<>'') and (Sec<>'') then Result.ReadIni(Ini,Sec);
 except
  on E:Exception do BugReport(E,nil,'NewUserHintsList');
 end;
end;

procedure Kill(var TheObject:TUserHintsList); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

procedure Init_UserHintsSubsystem;
begin
 SysUserHints.Ok;
 DaqUserHints.Ok;
end;

procedure Free_UserHintsSubsystem;
begin
 // Nothing to do yet.
end;

function LngKey(const Lng,Key:LongString):LongString; inline;
begin
 Result:=Lng+' '+Key;
end;

function FetchUserHints(const args:LongString; const def:LongString=''):LongString;
var arg,opt,opn,lng,key,scope,lst:LongString;
begin
 Result:=def;
 if IsNonEmptyStr(args) then
 try
  arg:=Trim(args);
  scope:=''; lst:=''; lng:='';
  while IsOption(arg) do begin
   opt:=ExtractWord(1,arg,ScanSpaces);
   arg:=SkipWords(1,arg,ScanSpaces);
   opn:=TrimLeftChars(opt,['-']);
   if IsOption(opt,'-sys','--sys') then scope:='sys' else
   if IsOption(opt,'-daq','--daq') then scope:='daq' else
   if IsOption(opt,'-list','--list') then lst:='list' else
   if IsOption(opt) and (Iso639.IndexOf(opn)>=0) then lng:=opn;
  end;
  key:=Trim(arg);
  if SameText(scope,'sys') then begin
   if (lng='') then lng:=SysUserHints.PrimeLanguage;
   if SameText(lst,'list')
   then Result:=SysUserHints.ListAsText
   else Result:=SysUserHints[lng,key];
  end else
  if SameText(scope,'daq') then begin
   if (lng='') then lng:=DaqUserHints.PrimeLanguage;
   if SameText(lst,'list')
   then Result:=DaqUserHints.ListAsText
   else Result:=DaqUserHints[lng,key];
  end;
  Result:=TrimDef(Result,def);
 except
  on E:Exception do BugReport(E,nil,'FetchUserHints');
 end;
end;

////////////////////////////////
// TUserHintsList implementation
////////////////////////////////

constructor TUserHintsList.Create;
begin
 inherited;
 myLanguages:=DefaultLanguages;
 myHintsList:=NewHashList(False,HashList_DefaultHasher);
 myHintsList.Master:=@myHintsList;
end;

destructor TUserHintsList.Destroy;
begin
 Kill(myHintsList);
 myLanguages:='';
 inherited;
end;

procedure TUserHintsList.AfterConstruction;
begin
 inherited;
 Clear;
end;

procedure TUserHintsList.BeforeDestruction;
begin
 Clear;
 inherited;
end;

function TUserHintsList.GetLanguages:LongString;
begin
 if Assigned(Self)
 then Result:=myLanguages
 else Result:='';
end;

procedure TUserHintsList.SetLanguages(arg:LongString);
var List:TStringList; iw:Integer; wi:LongString;
begin
 if Assigned(Self) then
 try
  List:=TStringList.Create;
  if Assigned(List) then
  try
   List.UseLocale:=False;
   arg+=(','+DefaultLanguages); // Fallback list
   for iw:=1 to WordCount(arg,ScanSpaces) do begin
    wi:=LoCaseStr(ExtractWord(iw,arg,ScanSpaces));
    if (Iso639.IndexOf(wi)<0) then continue;
    if (List.IndexOf(wi)>=0) then continue;
    List.Add(wi);
   end;
   myLanguages:=TrimDef(List.CommaText,DefaultLanguages);
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,Self,'SetLanguages');
 end;
end;

function TUserHintsList.GetDefaultLanguages:LongString;
begin
 if Assigned(Self)
 then Result:='en,ru'
 else Result:='';
end;

function TUserHintsList.GetPrimeLanguage:LongString;
begin
 if Assigned(Self)
 then Result:=ExtractWord(1,myLanguages,ScanSpaces)
 else Result:='';
end;

function TUserHintsList.GetCount:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myHintsList.Count;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetCount');
 end;
end;

function TUserHintsList.GetUserHints(const lng,key:LongString):LongString;
var iw,wc:Integer; wi,Langs:LongString; Sep:TCharSet;
begin
 Result:='';
 if (lng='') then Exit;
 if (key='') then Exit;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myHintsList.KeyedParams[LngKey(lng,key)];
   // Fallback if not found
   if (Result='') then begin
    Sep:=ScanSpaces;
    Langs:=myLanguages;
    wc:=WordCount(Langs,Sep);
    for iw:=1 to wc do begin
     wi:=ExtractWord(iw,Langs,Sep);
     if SameText(wi,lng) then continue;
     Result:=myHintsList.KeyedParams[LngKey(wi,key)];
     if (Result<>'') then break;
    end;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetUserHints');
 end;
end;

procedure TUserHintsList.SetUserHints(const lng,key,val:LongString);
begin
 if (lng='') then Exit;
 if (key='') then Exit;
 if (val='') then Exit;
 if Assigned(Self) then
 try
  Lock;
  try
   myHintsList.KeyedParams[LngKey(lng,key)]:=val;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetUserHints');
 end;
end;

function TUserHintsList.GetHasUserHints(const lng,key:LongString):Boolean;
begin
 Result:=False;
 if (lng='') then Exit;
 if (key='') then Exit;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=IsNonEmptyStr(myHintsList.KeyedParams[LngKey(lng,key)]);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetHasUserHints');
 end;
end;

procedure TUserHintsList.Clear;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   myHintsList.Clear;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Clear');
 end;
end;

function TUserHintsList.ReadIni(Ini,Sec:LongString):Integer;
var SecLng:LongString; iw,il:Integer; wi,Line,sn,sv:LongString;
var Lines:TStringList;
begin
 Result:=0;
 if (Ini='') then Exit;
 if (Sec='') then Exit;
 if Assigned(Self) then
 try
  wi:=''; Line:=''; sn:=''; sv:='';
  Ini:=UnifyFileAlias(Ini,ua_FileDefLow);
  if not FileIsReadable(Ini) then Exit;
  SecLng:=UnifySection(Sec+'.Languages');
  Languages:=ExtractEnumWordTextEx(Ini,SecLng,'Languages',efConfig,0);
  for iw:=1 to WordCount(Languages,ScanSpaces) do begin
   wi:=ExtractWord(iw,Languages,ScanSpaces);
   Lines:=TStringList.Create;
   if Assigned(Lines) then
   try
    SecLng:=UnifySection(Sec+'.'+wi);
    Lines.Text:=ExtractTextSection(Ini,SecLng,efConfigNC);
    for il:=Lines.Count-1 downto 0 do begin
     Line:=Lines[il];
     if (ExtractNameValuePair(Line,sn,sv)>0) then
     if IsNonEmptyStr(sn) and IsNonEmptyStr(sv) then begin
      UserHints[wi,sn]:=sv;
     end;
    end;
   finally
    Kill(Lines);
   end;
  end;
  Result:=Count;
 except
  on E:Exception do BugReport(E,Self,'ReadIni');
 end;
end;

function TUserHintsList.ListAsText:LongString;
var i:Integer; List:TStringList; key,val:LongString;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   List:=TStringList.Create;
   if Assigned(List) then
   try
    List.Duplicates:=dupIgnore;
    List.UseLocale:=False;
    List.Sorted:=True;
    for i:=0 to myHintsList.Count-1 do begin
     key:=myHintsList.Keys[i];
     val:=myHintsList.Params[i];
     List.Add(key+'='+val);
    end;
    Result:=List.Text;
   finally
    Kill(List);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'ListAsText');
 end;
end;

//////////////////////////////
// SysUserHints implementation
//////////////////////////////

const SysHints:TUserHintsList=nil;

function SysUserHints:TUserHintsList;
begin
 if not Assigned(SysHints) then begin
  SysHints:=NewUserHintsList(SysIniFile,'SysUserHints');
  SysHints.Master:=@SysHints;
 end;
 Result:=SysHints;
end;

//////////////////////////////
// DaqUserHints implementation
//////////////////////////////

const DaqHints:TUserHintsList=nil;

function DaqUserHints:TUserHintsList;
begin
 if not Assigned(DaqHints) then begin
  DaqHints:=NewUserHintsList;
  DaqHints.Master:=@DaqHints;
 end;
 Result:=DaqHints;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_uhints;
begin
end;

procedure Free_crw_uhints;
begin
 Kill(SysHints);
 Kill(DaqHints);
end;

initialization

 Init_crw_uhints;

finalization

 Free_crw_uhints;

end.

//////////////
// END OF FILE
//////////////

