////////////////////////////////////////////////////////////////////////////////
// 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:                                                                   //
// XDG related routines.                                                      //
// XDG is an abbreviation for X Desktop Group, now known as freedesktop.org.  //
////////////////////////////////////////////////////////////////////////////////

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

unit _crw_xdg; //  XDG related routines.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math, strutils, lclproc,
 {$IFDEF WINDOWS} comobj, shlobj, activex, {$ENDIF}
 _crw_alloc, _crw_rtc, _crw_ef, _crw_str;

const // see "Desktop Entry Specification".
 XDG_DESKTOP_ENTRY_SECTION='[Desktop Entry]';
const // LangString desktop entry standard keys.
 XDG_DESKTOP_STANDARD_LANG_KEYS='Name,GenericName,Comment,Icon,Keywords';
const // Boolean desktop entry standard keys.
 XDG_DESKTOP_STANDARD_BOOL_KEYS='NoDisplay,Hidden,DBusActivatable,Terminal,StartupNotify';
const // see "Desktop Entry Specification/Recognized desktop entry keys".
 XDG_DESKTOP_STANDARD_KEYS='Type,Version,Name,GenericName,NoDisplay,'
 +'Comment,Icon,Hidden,OnlyShowIn,NotShowIn,DBusActivatable,TryExec,'
 +'Exec,Path,Terminal,Actions,MimeType,Categories,Keywords,'
 +'StartupNotify,StartupWMClass,URL';
const // Addon Win32 shell link keys.
 XDG_DESKTOP_WIN32_KEYS='Hotkey,ShowCmd,WindowStyle';

type
 EMakeShellLink = class(ESoftException);

function MakeShellLinkFromText(TargetLnk,Content:LongString):Boolean;

implementation

procedure WinSaveLink(Lines:TStringList; TargetLnk:LongString);
{$IFDEF WINDOWS}
var exec,targ,args,desc,wdir,icon,hkey,show:LongString; hotk,wcmd:Integer;
var IObject:IUnknown;
{$ENDIF ~WINDOWS}
begin
 {$IFDEF WINDOWS}
 exec:=Lines.Values['Exec'];   wdir:=Lines.Values['Path'];
 icon:=Lines.Values['Icon'];   desc:=Lines.Values['Comment'];
 hkey:=Lines.Values['HotKey']; show:=Lines.Values['ShowCmd'];
 targ:=ExtractPhrase(1,exec,JustBlanks);
 args:=SkipPhrases(1,exec,JustBlanks);
 hotk:=StrToIntDef(hkey,-1);
 wcmd:=StrToIntDef(show,-1);
 IObject:=CreateComObject(CLSID_ShellLink);
 if Assigned(IObject) then begin
  // Unicode brunch as default
  if (IObject is IShellLinkW) then begin
   with (IObject as IShellLinkW) do begin
    if IsNonEmptyStr(targ) then SetPath(PWChar(StrToWide(targ)));
    if IsNonEmptyStr(args) then SetArguments(PWChar(StrToWide(args)));
    if IsNonEmptyStr(desc) then SetDescription(PWChar(StrToWide(desc)));
    if IsNonEmptyStr(icon) then SetIconLocation(PWChar(StrToWide(icon)),0);
    if IsNonEmptyStr(wdir) then SetWorkingDirectory(PWChar(StrToWide(wdir)));
    if (wcmd>=0) then SetShowCmd(wcmd);
    if (hotk>0) then SetHotkey(hotk);
   end;
   (IObject as IPersistFile).Save(PWChar(StrToWide(TargetLnk)),FALSE);
   Exit;
  end;
  // ANSI brunch as fallback
  if (IObject is IShellLinkA) then begin
   with (IObject as IShellLinkA) do begin
    if IsNonEmptyStr(targ) then SetPath(PChar(targ));
    if IsNonEmptyStr(args) then SetArguments(PChar(args));
    if IsNonEmptyStr(desc) then SetDescription(PChar(desc));
    if IsNonEmptyStr(icon) then SetIconLocation(PChar(icon),0);
    if IsNonEmptyStr(wdir) then SetWorkingDirectory(PChar(wdir));
    if (wcmd>=0) then SetShowCmd(wcmd);
    if (hotk>0) then SetHotkey(hotk);
   end;
   (IObject as IPersistFile).Save(PWChar(StrToWide(TargetLnk)),FALSE);
   Exit;
  end;
 end;
 raise EMakeShellLink.Create('IShellLink interface error.');
 {$ENDIF ~WINDOWS}
end;

procedure SaveLink(Lines:TStringList; TargetLnk:LongString);
begin
 if (Lines=nil) then Exit;
 if (Lines.Count=0) then Exit;
 if IsEmptyStr(TargetLnk) then Exit;
 if IsUnix then Lines.SaveToFile(TargetLnk);
 if IsWindows then WinSaveLink(Lines,TargetLnk);
end;

function MakeShellLinkFromText(TargetLnk,Content:LongString):Boolean;
var Lines,List:TStringList; Line,sn,sv,XdgKeys:LongString; i:Integer;
 function IsXdgDesktopStandardKey(s:LongString):Boolean;
 var p1,p2:Integer;
 begin
  if IsEmptyStr(s) then Exit(false);
  if (WordIndex(s,XdgKeys,ScanSpaces)>0) then Exit(true);
  p1:=Pos('[',s); p2:=Pos(']',s); if (p2>p1) and (p1>0) then s:=Copy(s,1,p1-1);
  if (WordIndex(sn,XDG_DESKTOP_STANDARD_LANG_KEYS,ScanSpaces)>0) then Exit(true);
  Result:=false;
 end;
 function IsXdgBoolKey(s:LongString):Boolean;
 begin
  Result:=(WordIndex(s,XDG_DESKTOP_STANDARD_BOOL_KEYS,ScanSpaces)>0);
 end;
 function IsHotkey(s:LongString):Boolean;
 begin
  Result:=SameText(s,'Hotkey');
 end;
 function FixName(s:LongString):LongString;
 var i:Integer;
 begin
  i:=WordIndex(s,XDG_DESKTOP_STANDARD_KEYS,ScanSpaces);
  if (i<=0)
  then Result:=s
  else Result:=ExtractWord(i,XDG_DESKTOP_STANDARD_KEYS,ScanSpaces);
 end;
 function FixBool(s:LongString):LongString;
 begin
  s:=Trim(s); if (s='') then Exit(s);
  if (WordIndex(s,'1,true,t,yes,y',ScanSpaces)>0) then Exit('true');
  if (WordIndex(s,'0,false,f,none,not,no,n',ScanSpaces)>0) then Exit('false');
  Result:=LowerCase(s);
 end;
 function FixHotkey(s:LongString):LongString;
 var sc:Integer;
 begin
  if not TryStrToInt(s,sc) then sc:=TextToShortCut(s);
  Result:=IntToStr(sc);
 end;
begin
 Result:=false;
 if IsNonEmptyStr(TargetLnk) then
 if IsNonEmptyStr(Content) then
 try
  XdgKeys:=XDG_DESKTOP_STANDARD_KEYS+IfThen(IsWindows,','+XDG_DESKTOP_WIN32_KEYS,'');
  TargetLnk:=UnifyFileAlias(AdaptLnkFileName(TargetLnk),ua_FileDefLow);
  if not DirectoryExists(ExtractFileDir(TargetLnk)) then Exit;
  Lines:=TStringList.Create;
  List:=TStringList.Create;
  try
   List.Text:=Content;
   for i:=0 to List.Count-1 do begin
    Line:=Trim(List[i]);
    if IsSectionName(Line) then begin
     if SameText(Line,XDG_DESKTOP_ENTRY_SECTION)
     then Lines.Text:=XDG_DESKTOP_ENTRY_SECTION
     else if (Lines.Count>0) then Break;
    end else begin
     if (ExtractNameValuePair(Line,sn,sv)>0) then begin
      if SameText(sn,'IconLocation') then sn:='Icon';
      if SameText(sn,'Description') then sn:='Comment';
      if SameText(sn,'WindowStyle') then sn:='ShowCmd';
      if SameText(sn,'WorkingDirectory') then sn:='Path';
      if SameText(sn,'TargetPath') or SameText(sn,'Arguments') then
      if (Lines.IndexOfName('Exec')>=0) then continue else begin
       sn:='Exec';
       sv:=QArg(CookieScan(Content,'TargetPath'))
           +' '+CookieScan(Content,'Arguments');
      end;
      if IsEmptyStr(sv) or IsEmptyStr(sn) then continue;
      if not IsXdgDesktopStandardKey(sn) then continue;
      if (Lines.IndexOfName(sn)>=0) then continue;
      if IsXdgBoolKey(sn) then sv:=FixBool(sv);
      if IsHotkey(sn) then sv:=FixHotkey(sv);
      Lines.Add(FixName(sn)+'='+Trim(sv));
     end;
    end;
   end;
   if (Lines.Count>0) then begin
    if (Lines.IndexOf(XDG_DESKTOP_ENTRY_SECTION)<0)
    then Lines.Insert(0,XDG_DESKTOP_ENTRY_SECTION);
    if (Lines.IndexOfName('Type')<0) and (Lines.IndexOfName('Exec')>=0)
    then Lines.Insert(1,'Type=Application');
    if (Lines.IndexOfName('Type')<0) and (Lines.IndexOfName('Path')>=0)
    then Lines.Insert(1,'Type=Directory');
    if (Lines.IndexOfName('Type')<0) and (Lines.IndexOfName('URL')>=0)
    then Lines.Insert(1,'Type=Link');
    if (Lines.IndexOfName('Version')<0)
    then Lines.Insert(1,'Version=1.0');
   end;
   if (Lines.Count>0) then begin
    SaveLink(Lines,TargetLnk);
    Result:=true;
   end;
  finally
   Lines.Free;
   List.Free;
  end;
 except
  on E:Exception do BugReport(E,nil,'MakeShellLinkFromText');
 end;
end;

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

procedure Init_crw_xdg;
begin
end;

procedure Free_crw_xdg;
begin
end;

initialization

 Init_crw_xdg;

finalization

 Free_crw_xdg;

end.

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

