unit desk;

interface
uses Graphics;

type
  { Shell }

  Shell=class
  class function GetServerPathUTF8(const Doc:utf8string):utf8string;
  class function GetServerPathW(const Doc:widestring):widestring;
  class function GetServerIcon(const path:widestring;gr:TPicture):boolean;
  class function GetSmallDocumentIcon(const path:widestring;gr:TPicture):boolean;
  class function GetMimeTypeUTF8(const path: utf8string):utf8string;
  class function GetMimeTypeW(const path: widestring):widestring;
  class function OpenDocumentW(const path:widestring):widestring;
  class function OpenDocumentUTF8(const path:utf8string):utf8string;
  {$ifdef UNIX}
  class function FindIcon(icon:string; size:integer):string;
  class function FindIconHelper(icon:string; size:integer; theme:string):string;
  class function LookupIcon (const iconname:string; size:integer;const theme:string):string;
  class function LookupFallbackIcon (const iconname:string):string;
  class function DirectoryMatchesSize(const subdir:string; iconsize:integer):boolean;
  {$endif}
  end;

implementation
uses classes,procexec,SysUtils,inifiles,pathtools,lxmlnode,options,strtools
     {$ifdef MSWINDOWS}
     ,windows,shellapi
     {$endif};

class function Shell.GetServerPathW(const Doc:widestring):widestring;
{$IFDEF MSWINDOWS}
var
  bs:ansistring;
  wBuf:array[0..1023] of widechar;
  sbuf:array[0..2047] of ansichar absolute wbuf;
  fMod:THandle;
begin
  Result:='?';
  fMod:=FindExecutableW(PWideChar(Doc),nil,wBuf);
  if fMod>hinstance_error then
    Result:=wBuf
  else
  begin
    bs:=Doc;
    fMod:=FindExecutableA(PAnsiChar(bs),nil,sBuf);
    if fMod>hinstance_error then
      Result:=sBuf
  end;
end;
{$ENDIF}
{$IFDEF UNIX}
begin
  Result:=utf8decode(GetServerPathUTF8(utf8encode(Doc)));
end;
{$ENDIF}

class function Shell.GetServerIcon(const path: widestring; gr: TPicture
  ): boolean;
{$ifdef MSWINDOWS}
type
  PHIcon=^HICON;
var
  cnt,ndx:integer;
  fIcon:HICON;
begin
  Result:=false;
  cnt:=ExtractIconExW(PWideChar(path),-1,PHIcon(nil)^,PHIcon(nil)^,1);
  // no icons in file
  if cnt=0 then exit;
  ndx:=0; // use 1-st icon, extract large icon (1st non-null argument)
  cnt:=ExtractIconExW(PWideChar(path),ndx,fIcon,PHIcon(nil)^,1);
  if cnt>0 then
  begin
    gr.icon.handle:=fIcon;
    Result:=true;
  end;
end;

(*var
  ico:HICON;
begin
  Result:=false;
  Ico:=ExtractIconW(hInstance,PWideChar(path),1);
  if (Ico<>1) and (Ico<>0) then
  begin
    gr.Icon.Handle:=Ico;
    Result:=true;
  end;
end;*)
{$else}
var
  ini:TIniFile;
  sicon:utf8string;
  lst:TwStringList;
begin
  try
    try
      lst:=TwStringList.Create;
      ini:=TMemIniFile.Create('/usr/share/applications/'+path);
      sicon:=ini.ReadString('Desktop Entry','Icon','');
      if sicon<>'' then
      begin
        FileSystem.BuildFileListWithMaskUTF8('/usr/share/icons/hicolor/32x32/apps/'+sicon+'.*',faAnyFile,lst);
        if Lst.Count=0 then
        FileSystem.BuildFileListWithMaskUTF8('/usr/share/icons/hicolor/48x48/apps/'+sicon+'.*',faAnyFile,lst);
        if lst.Count=0 then
        FileSystem.BuildFileListWithMaskUTF8('/usr/share/icons/hicolor/64x64/apps/'+sicon+'.*',faAnyFile,lst);
        if lst.Count>0 then
        begin
          gr.LoadFromFile(lst.uItem[0]);
          Result:=true;
        end;
      end;
    except
    end;
  finally
    ini.Free;
    lst.Free;
  end;
end;
{$endif}

class function Shell.GetServerPathUTF8(const Doc: utf8string): utf8string;
var
  bs:utf8string;
begin
  {$ifdef UNIX}
  bs:=GetMimeTypeUTF8(doc);
  Result:=''; // clear result
  if procexec.CallProcessSelector(
  	'xdg-mime',['query','default',bs],Result) then
  	Result:=Trim(Result)
  else
    Result:='?';

  {$else}
  Result:=utf8encode(GetServerPathW(utf8decode(Doc)));
  {$endif}
end;

class function Shell.GetMimeTypeUTF8(const path: utf8string):utf8string;
var
  bs:utf8string;
  lst:TStrLst;
begin
  Result:='';
  {$ifdef UNIX}
  bs:='';
  {$ifdef LINUX}
  if not procexec.CallProcessSelector(
  	'xdg-mime',['query','filetype',Path],bs) then
    exit;
  Result:=Trim(bs); // mime-type
  {$else}
  if not procexec.CallProcessSelector(
  	'file',['--mime',Path],bs) then
    exit;
  splitresp(bs,';:',lst);
  if length(lst)<2 then exit;
  Result:=Trim(lst[1]);
  {$endif}

  {$else}
  Result:='unimplemented';
  {$endif}
end;

class function Shell.GetMimeTypeW(const path: widestring):widestring;
begin
  Result:=utf8decode(GetMimeTypeUTF8(utf8encode(path)));
end;

class function Shell.OpenDocumentW(const path: widestring): widestring;
{$ifdef MSWINDOWS}var h:Hinst;{$endif}
begin
  Result:='';
  {$ifdef MSWINDOWS}
  h:=ShellExecuteW(GetDesktopWindow(),
                nil,
                PWideChar(path),
                '','',sw_show {na});
  {$else}
   Result:=utf8decode(Shell.OpenDocumentUTF8(utf8encode(path)));
  {$endif}
end;

class function Shell.OpenDocumentUTF8(const path: utf8string): utf8string;
var
  sproc:utf8string;
begin
  Result:='';
  {$ifdef MSWINDOWS}
  {$else}
    {$ifdef DARWIN}
    sproc:='open';
    {$else}
    sproc:='xdg-open';
    {$endif}
    procexec.CallProcessSelector(sproc,[path],Result);
  {$endif}
end;

class function Shell.GetSmallDocumentIcon(const path: widestring; gr: TPicture
  ): boolean;
{$ifdef MSWINDOWS}
type
  PHIcon=^HICON;
var
  wbuf:widestring;
  cnt,ndx:integer;
  fIcon:HICON;
begin
  Result:=false;
  wbuf:=GetServerPathW(path);
  cnt:=ExtractIconExW(PWideChar(wbuf),-1,PHIcon(nil)^,PHIcon(nil)^,1);
  // no icons in file
  if cnt=0 then exit;
  ndx:=1; // use 2-nd icon
  if cnt<2 then ndx:=0;
  cnt:=ExtractIconExW(PWideChar(wbuf),ndx,PHIcon(nil)^,fIcon,1);
  if cnt>0 then
  begin
    gr.icon.handle:=fIcon;
    Result:=true;
    //deleteobject(fLargeIcon);
  end;
end;
{$else}
var
  smime:utf8string;
  xml:TltParser;
  fs:TFileStream;
  sicon:utf8string;
  lst:TwStringList;
  nd:TltNode;
begin
  Result:=false;

  smime:=GetMimeTypeUTF8(utf8encode(path));
  try
    try
      fs:=TFileStream.Create('/usr/share/mime/'+smime+'.xml',fmOpenRead);
    except
      exit;
    end;
    lst:=TwStringList.Create;
    xml:=TltParser.Create();
    xml.Parse(fs);
    nd:=xml.Root.Find('icon');
    if not Assigned(nd) then
    nd:=xml.Root.Find('generic-icon');
    if Assigned(nd) then
      sicon:=options.GetValueByName(nd.Attr,'name',1,'')
    else
    begin
      // mime-type description has no icon,
      // the file is image itself like "image/jpeg"
      try
        gr.LoadFromFile(path);
        if not gr.Graphic.Empty then
        begin
      	  gr.Bitmap.SetSize(16,16);
          Result:=true;
          exit;
        end;
      except
      end;
      // try to resolve generic type
      sicon:=StringReplace(smime,'/','-',[rfReplaceAll]);
    end;

    if sicon<>'' then
    begin
      FileSystem.BuildFileListWithMaskUTF8('/usr/share/icons/Adwaita/16x16/mimetypes/'+sicon+'.*',faAnyFile,lst);
      if Lst.Count=0 then
      FileSystem.BuildFileListWithMaskUTF8('/usr/share/icons/Adwaita/32x32/mimetypes/'+sicon+'.*',faAnyFile,lst);
      if lst.Count>0 then
      begin
        gr.LoadFromFile(lst.uItem[0]);
        Result:=true;
      end;
    end;
  finally
    xml.free;
    fs.Free;
    lst.Free;
  end;


end;
{$endif}

{$ifdef UNIX}
class function Shell.FindIcon(icon:string; size:integer):string;
var
  filename,stheme:string;
begin
  stheme:='Adwaita';
  filename := Shell.FindIconHelper(icon, size, sTheme);
  if filename <>'' then
    exit(filename);

  filename := Shell.FindIconHelper(icon, size, 'hicolor');
  if filename <>'' then
    exit(filename);

  exit(LookupFallbackIcon(icon));
end;

class function Shell.FindIconHelper(icon:string; size:integer; theme:string):string;
var
  ini:TMemIniFile;
  i:integer;
  filename,parents:string;
  lst:TStrLst;
begin
  filename := LookupIcon (icon, size, theme);
  if filename<>'' then
    exit(filename);

  // if theme has parents
  ini:=TMemIniFile.Create('/usr/share/icons/'+theme+'/index.theme');
  try
    parents:=ini.ReadString('Icon Theme','inherits','');
    if parents='' then exit('');
  finally
    ini.Free;
  end;
  splitresp(parents,',',lst);
  for i:=0 to high(lst) do
  begin
    filename := FindIconHelper (icon, size, lst[i]{parent});
    if (filename<>'') then
      exit(filename);
  end;

  Result:='';
end;

const ext_list:array[0..2] of string[3]=('png', 'svg', 'xpm');

class function Shell.LookupIcon(const iconname:string; size:integer;const theme:string):string;
var
  ini:TMemIniFile;
  filename,subdir,dirs,closest_filename:string;
  i,j,minimal_size,sz:integer;
  lst,slst:TStrLst;
begin
 (* Result:='';
  ini:=TmemIniFile.Create('/usr/share/icons/'+theme+'/index.theme');
  try
    dirs:=ini.ReadString('Icon Theme','','Directories');
    if dirs='' then exit('');
  finally
    ini.Free;
  end;
  splitresp(dirs,',',lst);
  for i:=0 to high(lst) do
  begin
    splitresp(lst[i],'/',slst);
    for j:=0 to high(ext_list) do
    begin
      if DirectoryMatchesSize(slst[0],size) then
      begin
        filename:='/usr/share/icons/'+theme+'/'+lst[i]+'/'+iconname+'.'+ext_list[j];
        if FileSystem.FileExistsUTF8(filename) then
        exit(filename);
      end;
    end;
  end;

  closest_filename:='';
  minimal_size := MAXINT;
  for i:=0 to high(lst) do
  begin
    splitresp(lst[i],'/',slst);
    for j:=0 to high(ext_list) do
    begin
      filename:='/usr/share/icons/'+theme+'/'+lst[i]+'/'+iconname+'.'+ext_list[j];
      if FileSystem.FileExistsUTF8(filename) then
      begin
        sz:=DirectorySizeDistance(lst[i], size);
        if sz< minimal_size then
        begin
          closest_filename := filename;
          minimal_size := sz;
        end;
      end;
      exit(filename);

    end;
  end;

  if closest_filename<>'' then
     exit(closest_filename);
  *)
end;

class function Shell.LookupFallbackIcon (const iconname:string):string;
begin
 (* for each directory in $(basename list) {
    for extension in ("png", "svg", "xpm") {
      if exists directory/iconname.extension
        return directory/iconname.extension
    }
  }*)
  exit('');// none
end;

class function Shell.DirectoryMatchesSize(const subdir:string; iconsize:integer):boolean;
begin
 (* read Type and size data from subdir
  if Type is Fixed
    return Size == iconsize
  if Type is Scaled
    return MinSize <= iconsize <= MaxSize
  if Type is Threshold
    return Size - Threshold <= iconsize <= Size + Threshold
    *)
end;

type

  { TfdTheme }

  // FreeDesktop theme loader
  TfdTheme=class
    ini:TMemIniFile;
    constructor Create(const theme:string);
    destructor Destroy;override;
    function DirectorySizeDistance(const subdir:string; size:integer):integer;
  end;

{ TfdTheme }

constructor TfdTheme.Create(const theme: string);
begin
  ini:=TMemIniFile.Create('/usr/share/icons/'+theme+'/index.theme');
end;

destructor TfdTheme.Destroy;
begin
  ini.free;
  inherited Destroy;
end;

function TfdTheme.DirectorySizeDistance(const subdir:string; size:integer):integer;
var
  iconsize,minsize,maxsize,threshold:integer;
  stype,smin,smax:string;
begin
  stype:=ini.ReadString(subdir,'Type','');
  iconsize:=ini.ReadInteger(subdir,'Size',0);

  if stype='Fixed' then
     exit(abs(size-iconsize));

  if stype='Scaled' then
  begin
    minsize:=ini.ReadInteger(subdir,'MinSize',0);
    maxsize:=ini.ReadInteger(subdir,'MaxSize',0);
    if (iconsize<minsize) then
      exit(MinSize - iconsize);
    if (iconsize>MaxSize) then
      exit(iconsize - MaxSize);
    exit(0); // exact
  end;

  if stype='Threshold' then
  begin

  end;

  (*

  if Type is Scaled
    if iconsize < MinSize
        return MinSize - iconsize
    if iconsize > MaxSize
        return iconsize - MaxSize
    return 0
  if Type is Threshold
    if iconsize < Size - Threshold
        return MinSize - iconsize
    if iconsize > Size + Threshold
        return iconsize - MaxSize
    return 0
  *)
end;
{$endif}


end.