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

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

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Window manager control routines.                                           //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20230816 - Modified for FPC (A.K.) from _task                              //
////////////////////////////////////////////////////////////////////////////////

unit _crw_wmctrl; // Window control routines.

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, {$ENDIF}
 {$IFDEF WINDOWS} windows, {$ENDIF}
 sysutils, classes, math, types, ctypes,
 {$IFDEF UNIX} x, xlib, xatom, {$ENDIF}
 _crw_alloc, _crw_ef, _crw_str, _crw_fio, _crw_proc, _crw_crypt;

const
 glow_defmode : Integer = 4;

 {
 Get list of desktop windows as $HWND, PID, Class, Title
 }
function GetListOfWindows(aPid:Cardinal; aClass,aTitle:LongString; aMode:Integer=-1):LongString; overload;

 {
 Get list of desktop windows by arg=PID "Window Class" "Window Title".
 }
function GetListOfWindows(const arg:LongString; aMode:Integer=-1):LongString; overload;

 { Formatter for internal use. }
function wmctrl_format_line(aWin:TWindow; aDesk,aPid:Cardinal;
               aClass:LongString; cLen:Cardinal; aHost:LongString;
               aTitle:LongString; aMode:Integer):LongString;

{$IFDEF UNIX}
 { Get property (prop_name) of window (win) on display (disp) as string dump. }
function wmctrl_get_property(disp:PDisplay; win:TWindow; xa_prop_type:TAtom; prop_name:PChar):LongString;

 { Get client's TWindow list as delimited string. }
function wmctrl_get_client_list(disp:PDisplay; Delim:LongString=EOL):LongString;

 { Get window desktop ID. }
function wmctrl_get_desktop_id(disp:PDisplay; win:TWindow; def:Cardinal=0):Cardinal;

  { Get window PID. }
function wmctrl_get_window_pid(disp:PDisplay; win:TWindow; def:Cardinal=0):Cardinal;

  { Get client machine name. }
function wmctrl_get_client_machine(disp:PDisplay; win:TWindow; def:LongString=''):LongString;

  { Get window title. }
function wmctrl_get_window_title(disp:PDisplay; win:TWindow; def:LongString=''):LongString;

  { Get window class. }
function wmctrl_get_window_class(disp:PDisplay; win:TWindow; def:LongString=''):LongString;

 { Get active window handle. }
function wmctrl_get_active_window(disp:PDisplay; def:TWindow=0):TWindow;
{$ENDIF ~UNIX}

implementation

{$IFDEF WINDOWS}

type
 TEnumGlowRec = packed record
  List:TStringList;
  lpClass,lpTitle,Buffer:LongString;
  Pid:Cardinal;
  Mode:Integer;
 end;

function EnumGlowProc(Wnd:HWND; Param:LPARAM):BOOL; stdcall;
var aPid:DWORD; aClass,aTitle:LongString;
begin
 Result:=true;
 if (Param<>0) then with TEnumGlowRec(Pointer(Param)^) do
 try
  if (Wnd=0) or not IsWindow(Wnd) then Exit;
  aPid:=0; GetWindowThreadProcessId(Wnd,@aPid);
  if (Pid<>0) and (Pid<>aPid) then Exit;
  aClass:=''; aTitle:='';
  try
   SetString(aClass,PChar(Buffer),GetClassName(Wnd,PChar(Buffer),Length(Buffer)));
   if (lpClass<>'') and not SameText(lpClass,aClass) then Exit;
   SetString(aTitle,PChar(Buffer),GetWindowText(Wnd,PChar(Buffer),Length(Buffer)));
   if (lpTitle<>'') and not SameText(lpTitle,aTitle) then Exit;
   List.Add(wmctrl_format_line(Wnd,0,aPid,aClass,1,HostName,aTitle,aMode););
  finally
   aClass:=''; aTitle:='';
  end;
 except
  on E:Exception do BugReport(E,nil,'EnumGlowProc');
 end;
end;

// List windows as $HWND, PID, Class, Title
function GetListOfWindows(aPid:Cardinal; aClass,aTitle:LongString; aMode:Integer=0):LongString;
var R:TEnumGlowRec; const BuffSize=1024*4;
begin
 Result:='';
 if (aMode=-1) then aMode:=glow_defmode;
 try
  SafeFillChar(R,SizeOf(R),0);
  SetLength(R.Buffer,BuffSize);
  R.List:=TStringList.Create;
  // List windows as $HWND, PID, Class, Title
  try
   R.Pid:=aPid;
   R.lpClass:=aClass;
   R.lpTitle:=aTitle;
   R.Buffer:=''; R.Mode:=aMode;
   EnumWindows(@EnumGlowProc,LPARAM(@R));
   if (R.List.Count>0) then Result:=R.List.Text;
  finally
   R.List.Free;
   R.lpClass:='';
   R.lpTitle:='';
   R.Buffer:='';
  end;
 except
  on E:Exception do BugReport(E,nil,'GetListOfWindows');
 end;
end;
{$ENDIF ~WINDOWS}

{$IFDEF UNIX}
const
 MAX_PROPERTY_VALUE_LEN = 4096;

function wmctrl_get_property(disp:PDisplay; win:TWindow; xa_prop_type:TAtom; prop_name:PChar):LongString;
var xa_prop_name,xa_ret_type:TAtom; ret_format:cint; ret_nitems,ret_bytes_after:culong; ret_prop:Pcuchar;
var item_size,data_size:Integer;
begin
 Result:='';
 if (win<>0) then
 if Assigned(disp) then
 if Assigned(prop_name) then
 try
  xa_prop_name:=XInternAtom(disp,prop_name,false);
  if (XGetWindowProperty(disp,win,xa_prop_name,0,(MAX_PROPERTY_VALUE_LEN div 4),false,
      xa_prop_type,@xa_ret_type,@ret_format,@ret_nitems,@ret_bytes_after,@ret_prop)=Success)
  then
  try
   if (xa_ret_type<>xa_prop_type) then Exit;
   case ret_format of
    8:   item_size:=1; // Byte
    16:  item_size:=2; // Word
    32:  item_size:=4; // Long
    else item_size:=0;
   end;
   if IsCpu64 and (item_size=4) and (xa_prop_type=XA_WINDOW)
   then item_size:=SizeOf(TWindow);
   data_size:=item_size*ret_nitems;
   Result:=StringBuffer(PChar(ret_prop),data_size);
  finally
   XFree(ret_prop);
  end;
 except
  on E:Exception do BugReport(E,nil,'get_property');
 end;
end;

function wmctrl_open_display(var disp:PDisplay; out NeedClose:Boolean):Boolean;
begin
 NeedClose:=false;
 if not Assigned(disp) then begin
  disp:=XOpenDisplay(nil);
  NeedClose:=true;
 end;
 Result:=Assigned(disp);
end;

procedure wmctrl_close_display(disp:PDisplay; NeedClose:Boolean);
begin
 if Assigned(disp) then
 if NeedClose then XCloseDisplay(disp);
end;

function wmctrl_get_client_list(disp:PDisplay; Delim:LongString=EOL):LongString;
var win:TWindow; NeedClose:Boolean; List:TStringList;
var pw:PWindow; buff:LongString; iw,cw:Integer;
var pc:PCardinal;
begin
 Result:='';
 if wmctrl_open_display(disp,NeedClose) then
 try
  List:=TStringList.Create;
  win:=DefaultRootWindow(disp);
  buff:=wmctrl_get_property(disp,win,XA_WINDOW,'_NET_CLIENT_LIST');
  if (buff<>'') then begin
   pw:=Pointer(buff); cw:=(Length(buff) div SizeOf(pw[0]));
   for iw:=0 to cw-1 do List.Add(IntToStr(pw[iw]));
  end;
  if (buff='') then begin
   buff:=wmctrl_get_property(disp,win,XA_CARDINAL,'_WIN_CLIENT_LIST');
   if (buff<>'') then begin
    pc:=Pointer(buff); cw:=(Length(buff) div SizeOf(pc[0]));
    for iw:=0 to cw-1 do List.Add(IntToStr(pc[iw]));
   end;
  end;
  Result:=Trim(List.Text);
  if (Delim<>EOL) then Result:=StringReplace(Result,EOL,Delim,[rfReplaceAll]);
 finally
  List.Free;
  wmctrl_close_display(disp,NeedClose);
 end;
end;

function wmctrl_get_desktop_id(disp:PDisplay; win:TWindow; def:Cardinal=0):Cardinal;
var s:LongString; NeedClose:Boolean;
begin
 Result:=def;
 if wmctrl_open_display(disp,NeedClose) then
 try
  s:=wmctrl_get_property(disp,win,XA_CARDINAL,'_NET_WM_DESKTOP');
  if (s='') then s:=wmctrl_get_property(disp,win,XA_CARDINAL,'_WIN_WORKSPACE');
  if (Length(s)=SizeOf(Result)) then Result:=Cardinal(Pointer(s)^);
 finally
  wmctrl_close_display(disp,NeedClose);
 end;
end;

function wmctrl_get_window_pid(disp:PDisplay; win:TWindow; def:Cardinal=0):Cardinal;
var s:LongString; NeedClose:Boolean;
begin
 Result:=def;
 if wmctrl_open_display(disp,NeedClose) then
 try
  s:=wmctrl_get_property(disp,win,XA_CARDINAL,'_NET_WM_PID');
  if (Length(s)=SizeOf(Result)) then Result:=Cardinal(Pointer(s)^);
 finally
  wmctrl_close_display(disp,NeedClose);
 end;
end;

function wmctrl_get_client_machine(disp:PDisplay; win:TWindow; def:LongString=''):LongString;
var NeedClose:Boolean;
begin
 Result:=def;
 if wmctrl_open_display(disp,NeedClose) then
 try
  Result:=wmctrl_get_property(disp,win,XA_STRING,'WM_CLIENT_MACHINE');
  if (Result='') then Result:=def else Result:=TrimRightChars(Result,[#0]);
 finally
  wmctrl_close_display(disp,NeedClose);
 end;
end;

function wmctrl_get_window_title(disp:PDisplay; win:TWindow; def:LongString=''):LongString;
var NeedClose:Boolean;
begin
 Result:=def;
 if wmctrl_open_display(disp,NeedClose) then
 try
  Result:=wmctrl_get_property(disp,win,XInternAtom(disp,'UTF8_STRING',false),'_NET_WM_NAME');
  if (Result='') then Result:=wmctrl_get_property(disp,win,XA_STRING,'WM_NAME');
  if (Result='') then Result:=def else Result:=TrimRightChars(Result,[#0]);
 finally
  wmctrl_close_display(disp,NeedClose);
 end;
end;

function wmctrl_get_window_class(disp:PDisplay; win:TWindow; def:LongString=''):LongString;
var NeedClose:Boolean;
begin
 Result:=def;
 if wmctrl_open_display(disp,NeedClose) then
 try
  Result:=wmctrl_get_property(disp,win,XA_STRING,'WM_CLASS');
  if (Result='') then Result:=def else Result:=StringReplace(TrimRightChars(Result,[#0]),#0,'.',[]);
 finally
  wmctrl_close_display(disp,NeedClose);
 end;
end;

function wmctrl_get_active_window(disp:PDisplay; def:TWindow=0):TWindow;
var s:LongString; win:TWindow; NeedClose:Boolean;
begin
 Result:=def;
 if wmctrl_open_display(disp,NeedClose) then
 try
  win:=DefaultRootWindow(disp);
  s:=wmctrl_get_property(disp,win,XA_WINDOW,'_NET_ACTIVE_WINDOW');
  if (Length(s)=SizeOf(Result)) then Result:=TWindow(Pointer(s)^);
 finally
  wmctrl_close_display(disp,NeedClose);
 end;
end;

function GetListOfWindows(aPid:Cardinal; aClass,aTitle:LongString; aMode:Integer=-1):LongString;
var disp:PDisplay; List,Wins:TStringList; dsk,pid:Cardinal; line,scm,swt,swc:LongString;
var win:TWindow; sWin:LongString; cWin,iWin,lcm:Integer;
begin
 Result:='';
 if (aMode=-1) then aMode:=glow_defmode;
 try
  disp:=XOpenDisplay(nil);
  if (disp=nil) then Exit;
  List:=TStringList.Create;
  Wins:=TStringList.Create;
  try
   sWin:=wmctrl_get_client_list(disp);
   Wins.Text:=sWin; cWin:=Wins.Count;
   lcm:=0;
   for iWin:=0 to cWin-1 do begin
    win:=StrToQWordDef(Wins[iWin],0);
    scm:=wmctrl_get_client_machine(disp,win);
    lcm:=Max(lcm,Length(scm));
   end;
   for iWin:=0 to cWin-1 do begin
    win:=StrToQWordDef(Wins[iWin],0);
    pid:=wmctrl_get_window_pid(disp,win,0);
    swc:=wmctrl_get_window_class(disp,win,'N/A');
    swt:=wmctrl_get_window_title(disp,win,'N/A');
    scm:=wmctrl_get_client_machine(disp,win,'N/A');
    dsk:=wmctrl_get_desktop_id(disp,win,High(dsk));
    if (aPid<>0) and (pid<>aPid) then continue;
    if (aClass<>'') and not SameText(swc,aClass) then continue;
    if (aTitle<>'') and not SameText(swt,aTitle) then continue;
    line:=wmctrl_format_line(win,dsk,pid,swc,lcm,scm,swt,aMode);
    //line:=Format('0x%.8x %2d %-6u %-20s %*s %s',[win,dsk,pid,swc,lcm,scm,swt]);
    List.Add(line);
   end;
   Result:=List.Text;
  finally
   Wins.Free;
   List.Free;
   XCloseDisplay(disp);
  end;
 except
  on E:Exception do BugReport(E,nil,'GetListOfWindows');
 end;
end;
{$ENDIF ~UNIX}

function wmctrl_format_line(aWin:TWindow; aDesk,aPid:Cardinal;
               aClass:LongString; cLen:Cardinal; aHost:LongString;
               aTitle:LongString; aMode:Integer):LongString;
begin
 case aMode of
  //// wmctrl -l
  //// 0x05800007  1 y510p ~ : bash — Терминал Fly
  //////////////////////////////////////////////////////////////////////////////
  0:   Result:=Format('0x%.8x %2d %*s %s',[aWin,aDesk,cLen,aHost,aTitle]);
  //// wmctrl -lp
  //// 0x05800007  1 4413   y510p ~ : bash — Терминал Fly
  //////////////////////////////////////////////////////////////////////////////
  1:   Result:=Format('0x%.8x %2d %-6u %*s %s',[aWin,aDesk,aPid,cLen,aHost,aTitle]);
  //// wmctrl -lx  =>
  //// 0x05800007  1 fly-term.fly-term    y510p ~ : bash — Терминал Fly
  //////////////////////////////////////////////////////////////////////////////
  2:   Result:=Format('0x%.8x %2d %-20s %*s %s',[aWin,aDesk,aClass,cLen,aHost,aTitle]);
  //// wmctrl -lpx =>
  //// 0x05800007  1 4413   fly-term.fly-term    y510p ~ : bash — Терминал Fly
  //////////////////////////////////////////////////////////////////////////////
  3:   Result:=Format('0x%.8x %2d %-6u %-20s %*s %s',[aWin,aDesk,aPid,aClass,cLen,aHost,aTitle]);
  //// Default
  //// $5800007, 4413, fly-term.fly-term, ~ : bash — Терминал Fly
  //////////////////////////////////////////////////////////////////////////////
  4:   Result:=Format('$%X, %u, %s, %s',[aWin,aPid,aClass,aTitle]);
  //// Default with Quites
  //// 92274695, 4413, "fly-term.fly-term", "~ : bash — Терминал Fly"
  //////////////////////////////////////////////////////////////////////////////
  5:   Result:=Format('%u, %u, %s, %s',[aWin,aPid,AnsiQuotedStr(aClass,QuoteMark),AnsiQuotedStr(aTitle,QuoteMark)]);
  //// Fallback
  //// 92274695, 1, 4413, "fly-term.fly-term", y510p, "~ : bash — Терминал Fly"
  //////////////////////////////////////////////////////////////////////////////
  else Result:=Format('%u, %u, %u, %s, %s, %s',[aWin,aDesk,aPid,AnsiQuotedStr(aClass,QuoteMark),aHost,AnsiQuotedStr(aTitle,QuoteMark)]);
 end;
end;

function GetListOfWindows(const arg:LongString; aMode:Integer=-1):LongString;
var pid:Integer; w1,w2:LongString;
begin
 Result:='';
 pid:=StrToIntDef(ExtractFirstParam(arg,QuoteMark,ScanSpaces),0);
 w2:=SkipFirstParam(arg,QuoteMark,ScanSpaces);
 w1:=ExtractFirstParam(w2,QuoteMark,ScanSpaces);
 w2:=SkipFirstParam(w2,QuoteMark,ScanSpaces);
 if (StrFetch(w2,1)=QuoteMark) then w2:=AnsiDeQuotedStr(w2,QuoteMark);
 Result:=GetListOfWindows(pid,w1,w2,aMode);
end;

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

procedure Init_crw_wmctrl;
begin
end;

procedure Free_crw_wmctrl;
begin
end;

initialization

 Init_crw_wmctrl;

finalization

 Free_crw_wmctrl;

end.

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

