unit fpwmmanager;
{$mode objfpc}
{$H+}
interface
{$include fpwmdefines.inc}
uses
  SysUtils, fgl, Classes,
  ctypes, x, xlib, xutil, baseunix, unix, xshape, xproto, xatom,
  {$ifdef FPWM_USE_LCL}
  Menus,
  {$endif}
  {$ifdef FPWM_ROTATED}
  fpwmrotated,
  {$endif}
  fpwmgeneral;
const
  Pdelete    = 1;
  PtakeFocus = 2;
type
  TFPWMBorder = class;
  TFPWMClient = class;
  TClientList = specialize TFPGList<TFPWMClient>;
  RootCursor = (NormalCursor, DeleteCursor, DownCursor, RightCursor, DownrightCursor);
  TFPWMWindowManager = class
  private
    m_display: PDisplay;
    m_screenNumber: cint;
    m_root: TWindow;
    m_defaultColormap: TColormap;
    m_minimumColormaps: cint;
    m_cursor: TCursor;
    m_xCursor: TCursor;
    m_vCursor: TCursor;
    m_hCursor: TCursor;
    m_vhCursor: TCursor;
    m_terminal: PChar;
    m_shell: PChar;
    m_clients: TClientList;
    m_hiddenClients: TClientList;
    m_activeClient: TFPWMClient;
    m_shapeEvent: cint;
    m_currentTime: cint;
    m_looping: Boolean;
    m_returnCode: cint;
    procedure release();
    class function makeCursor(d: PDisplay; w: TWindow;
      bits, mask_bits: PByte; width, height, xhot, yhot: cint;
      var fg, bg: TXColor): TCursor;
    class procedure sigHandler();
    procedure initialiseScreen();
    procedure scanInitialWindows();
  private
    m_menuGC: TGC;
    m_menuWindow: TWindow;
    m_menuFont: PXFontStruct;
    m_menuForegroundPixel: culong;
    m_menuBackgroundPixel: culong;
    m_menuBorderPixel: culong;
    procedure showDesktopMenu(e: PXButtonEvent);
    {$ifdef FPWM_USE_LCL}
    procedure showDesktopMenuLCL(e: PXButtonEvent);
    {$else}
    procedure showDesktopMenuX11(e: PXButtonEvent);
    {$endif}
    procedure spawn();
    procedure circulate(activeFirst: Boolean);
  private
    m_focusChanging: Boolean;	
    m_focusCandidate: TFPWMClient;
    m_focusCandidateWindow: TWindow;
    m_focusTimestamp: X.TTime;	
    m_focusPointerMoved: Boolean;
    m_focusPointerNowStill: Boolean;
    procedure checkDelaysForFocus();
    procedure nextEvent(e: PXEvent);	
    procedure eventButton(e: PXButtonEvent);
    procedure eventMapRequest(e: PXMapRequestEvent);
    procedure eventConfigureRequest(e: PXConfigureRequestEvent);
    procedure eventUnmap(e: PXUnmapEvent);
    procedure eventCreate(e: PXCreateWindowEvent);
    procedure eventDestroy(e: PXDestroyWindowEvent);
    procedure eventClient(e: PXClientMessageEvent);
    procedure eventColormap(e: PXColormapEvent);
    procedure eventProperty(e: PXPropertyEvent);
    procedure eventEnter(e: PXCrossingEvent);
    procedure eventReparent(e: PXReparentEvent);
    procedure eventFocusIn(e: PXFocusInEvent);
  public
    constructor Create();
    destructor Destroy();
    function MainLoop(): cint; 
    procedure InitWM();
    procedure fatal(const message: string);
  public
    function windowToClient(w: TWindow; acreate: Boolean = False): TFPWMClient;
    function activeClient(): TFPWMClient;
    function raiseTransients(C: TFPWMClient): Boolean; 
    function timestamp(reset: Boolean): x.TTime;
    procedure clearFocus();
    procedure setActiveClient(const c: TFPWMClient);
    procedure addToHiddenList(c: TFPWMClient);
    procedure removeFromHiddenList(c: TFPWMClient);
    procedure skipInRevert(c, myRevert: TFPWMClient);
    function display(): PDisplay;
    function root(): TWindow;
    procedure installCursor(c: RootCursor);
    procedure installCursorOnWindow(c: RootCursor; w: TWindow);
    procedure installColormap(cmap: TColormap);
    function allocateColour(name, desc: string): culong;
    procedure considerFocusChange(c: TFPWMClient; w: TWindow; atimestamp: x.TTime);
    procedure stopConsideringFocus();
    function attemptGrab(w: TWindow; constrain: TWindow; mask: Integer; t: Integer): Integer;
    procedure releaseGrab(e: PXButtonEvent);
    procedure eventExposure(e: PXExposeEvent);	
    procedure showGeometry(x, y: cint);
    procedure removeGeometry();
  end;
  TFPWMClient = class
  public
    constructor Create(wm: TFPWMWindowManager; w: TWindow);
    procedure release();
    procedure activate();		
    procedure deactivate();		
    procedure gravitate(invert: Boolean);
    procedure installColormap();
    procedure unreparent();
    procedure withdraw(changeState: Boolean = True);
    procedure hide();
    procedure unhide(map: Boolean);
    procedure rename();
    procedure kill();
    procedure mapRaised();		
    procedure lower();
    procedure move(e: PXButtonEvent);		
    procedure resize(e: PXButtonEvent; horizontal, vertical: Boolean);
    procedure moveOrResize(e: PXButtonEvent);
    procedure ensureVisible();	
    procedure manage(mapped: Boolean);
    function hasWindow(w: TWindow): Boolean; 
    function revertTo(): TFPWMClient; 
    procedure setRevertTo(c: TFPWMClient); 
    function isHidden(): Boolean;     
    function isWithdrawn(): Boolean;  
    function isNormal(): Boolean;     
    function isTransient(): Boolean;  
    function transientFor(): TWindow; 
    function isFixedSize(): Boolean;  
    function GetLabel(): string;    
    function name(): string;     
    function iconName(): string; 
    procedure sendMessage(a: TAtom; l: clong);
    procedure sendConfigureNotify();
    procedure activateAndWarp();
    procedure focusIfAppropriate(ifActive: Boolean);
    procedure selectOnMotion(w: TWindow; select: Boolean);
    procedure fatal(m: string);    
    function display(): PDisplay;     
    function parent(): TWindow;        
    function root(): TWindow;          
    function activeClient(): TFPWMClient; 
    function isActive(): Boolean;     
    function windowManager(): TFPWMWindowManager; 
    procedure eventButton(e: PXButtonEvent);
    procedure eventMapRequest(e: PXMapRequestEvent);
    procedure eventConfigureRequest(e: PXConfigureRequestEvent);
    procedure eventUnmap(e: PXUnmapEvent);
    procedure eventColormap(e: PXColormapEvent);
    procedure eventProperty(e: PXPropertyEvent);
    procedure eventEnter(e: PXCrossingEvent);
    procedure eventFocusIn(e: PXFocusInEvent);
    procedure eventExposure(e: PXExposeEvent);
  public
    destructor Destroy();
  private
    m_window: TWindow;
    m_transient: TWindow;
    m_border: TFPWMBorder;
    m_revert: TFPWMClient;
    m_x, m_y, m_w, m_h, m_bw: cint;
    m_sizeHints: TXSizeHints;
    m_fixedSize: Boolean;
    m_minWidth: cint;
    m_minHeight: cint;
    procedure fixResizeDimensions(var w, h, dw, dh: cint);
    function coordsInHole(x, y: cint): Boolean;
  private
    m_state: cint;
    m_protocol: cint;
    m_managed: Boolean;
    m_reparenting: Boolean;
    m_stubborn: Boolean;		
    m_lastPopTime: x.TTime; 
    m_name: string;
    m_iconName: string;
    m_label: string;	
    m_colormap: TColormap;
    m_colormapWinCount: cint;
    m_colormapWindows: PWindow;
    m_windowColormaps: PColormap;
    m_windowManager: TFPWMWindowManager;
    function getProperty(a: TAtom): string;
    function getAtomProperty(a, type_: TAtom): cint;
    function getIntegerProperty(a: TAtom): cint;
  private
    function getState(var state: cint): Boolean;
    procedure setState(state: cint);
  private
    function setLabel(): Boolean;	
    procedure getColormaps();
    procedure getProtocols();
    procedure getTransient();
    procedure decorate(active: Boolean);
  end;
  TFPWMBorder = class  
  private
    m_client: TFPWMClient;
    m_parent, m_tab, m_child,
     m_button, m_resize: TWindow;
    m_label: string;
    procedure fatal(s: string);
    procedure fixTabHeight(maxHeight: cint);
    procedure drawLabel();
    procedure setFrameVisibility(visible: Boolean; w, h: cint);
    procedure setTransientFrameVisibility(visible: Boolean; w, h: cint);
    procedure shapeParent(w, h: cint);
    procedure shapeTransientParent(w, h: cint);
    procedure shapeTab(w, h: cint);
    procedure resizeTab(h: cint);	
    procedure shapeResize();
  private
    m_prevW: cint;
    m_prevH: cint;
    m_tabHeight: cint;	
    constructor Create(const c: TFPWMClient; child: TWindow);
    destructor Destroy();
    procedure map();
    procedure unmap();
    procedure lower();
    procedure mapRaised();
    procedure decorate(active: Boolean; w, h: cint);
    procedure reparent();
    procedure configure(x, y, w, h: cint; mask: culong; detail: cint;
		   force: Boolean = False);
    procedure moveTo(x, y: cint);
    function windowManager(): TFPWMWindowManager; 
    function isTransient(): Boolean;	
    function isFixedSize(): Boolean;	
    function parent(): TWindow; 
    function hasWindow(w: TWindow): Boolean; 
    function display(): PDisplay;
    function root(): TWindow;
    procedure expose_(e: PXExposeEvent);
    procedure eventButton(e: PXButtonEvent); 
    function yIndent(): cint;
    function xIndent(): cint;
    function coordsInHole(x, y: cint): Boolean; 
  end;
var
  m_initialising: Boolean;
  m_defaultLabel: string = 'incognito';
  m_menuCreateLabel: string = 'New';
  m_signalled: cint;
  m_tabHeight: cint = -1;  
  m_tabWidth: cint = -1;
  {$ifdef FPWM_ROTATED}
  m_tabFont: PXRotFontStruct = nil;
  {$else}
  m_tabFont: TXFontStruct;
  {$endif}
  m_drawGC: xlib.TGC = nil;
  m_foregroundPixel,
   m_backgroundPixel,
   m_frameBackgroundPixel,
   m_buttonBackgroundPixel,
   m_borderPixel: culong;
  borderCounter: cint = 0;
function errorHandler(d: PDisplay; e: PXErrorEvent): cint; cdecl;
function nobuttons(e: PXButtonEvent): Boolean; 
implementation
const
  AllButtonMask = ( Button1Mask or Button2Mask or Button3Mask or Button4Mask or Button5Mask );
  ButtonMask    = ( ButtonPressMask or ButtonReleaseMask );
  DragMask      = ( ButtonMask or ButtonMotionMask );
  MenuMask      = ( ButtonMask or ButtonMotionMask or ExposureMask );
  MenuGrabMask  = ( ButtonMask or ButtonMotionMask or StructureNotifyMask );
function errorHandler(d: PDisplay; e: PXErrorEvent): cint; cdecl;
var
  msg: array[0..99] of Char;
  number: array[0..29] of Char;
  request: array[0..99] of Char;
begin
    if m_initialising and (e^.request_code = X_ChangeWindowAttributes) and
	(e^.error_code = BadAccess) then
    begin
	WriteLn('fpwm error: Is another window manager running?');
	exit(1);
    end;
    if (ignoreBadWindowErrors = True) and (e^.error_code = BadWindow) then Exit(0);
    XGetErrorText(d, e^.error_code, msg, 100);
    WriteLn(Format('fpwm error: %d', [e^.request_code]));
    XGetErrorDatabaseText(d, 'XRequest', number, '', request, 100);
    if (request[0] = #0) then
      request := Format('<request-code-%x>', [e^.request_code]);
    WriteLn(Format('fpwm: %s (%d): %s', [request, e^.resourceid, msg]));
    if (m_initialising) then
    begin
	WriteLn('fpwm: failure during initialisation, abandoning');
	exit(1);
    end;
    Result := 0;
end;
function nobuttons(e: PXButtonEvent): Boolean; 
var
  state: cint;
begin
  state := (e^.state and AllButtonMask);
  Result := (e^._type = ButtonRelease) and (0 <> state and (state - 1));
  Result := not Result;
end;
{$I fpwmmanager_inline_manager.inc}
{$I fpwmmanager_inline_client.inc}
{$I fpwmmanager_inline_border.inc}
{$I fpwmmanager.inc}
{$I fpwmbuttons_manager.inc}
{$I fpwmevents_manager.inc}
{$I fpwmclient.inc}
{$I fpwmbuttons_client.inc}
{$I fpwmevents_client.inc}
{$I fpwmborder.inc}
{$I fpwmbuttons_border.inc}
{$I fpwmevents_border.inc}
end.
