* Improved modal form in X11 to use net window hints

* Implemented NET_WM_PING so newer window managers can kill our process if it stops responding
* Changed how Modal form are stored. fpgApplication now keeps a stack/list of Modal Forms
* Added fpgApplication PushModalForm and PopModalForm
* Fixed a bug in WindowAddProtocol which caused a libc doublefree error

5 files changed, 207 insertions, 50 deletions

diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas
index e67989b4..9975e795 100644
--- a/src/corelib/fpgfx.pas
+++ b/src/corelib/fpgfx.pas
@@ -592,7 +592,7 @@ begin
   FDisplayParams  := aparams;
   FScreenWidth    := -1;
   FScreenHeight   := -1;
-  TopModalForm   := nil;
+  FModalFormStack := TList.Create;
 
   inherited Create(aparams);
   
@@ -617,6 +617,7 @@ begin
 
   FFontResList.Free;
   FDefaultFont.Free;
+  FreeAndNil(FModalFormStack);
   inherited Destroy;
 end;
 
diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas
index 41430d7a..b584ce33 100644
--- a/src/corelib/gfxbase.pas
+++ b/src/corelib/gfxbase.pas
@@ -370,19 +370,25 @@ type
   end;
 
 
+  { TfpgApplicationBase }
+
   TfpgApplicationBase = class(TObject)
   private
     FMainForm: TfpgWindowBase;
     FTerminated: boolean;
-    FTopModalForm: TfpgWindowBase;
+    function GetTopModalForm: TfpgWindowBase;
   protected
     FIsInitialized: Boolean;
+    FModalFormStack: TList;
     function    DoGetFontFaceList: TStringList; virtual; abstract;
   public
     constructor Create(const AParams: string); virtual; abstract;
     function    GetFontFaceList: TStringList;
+    procedure   PushModalForm(AForm: TfpgWindowBase);
+    procedure   PopModalForm;
+    function    PrevModalForm: TfpgWindowBase;
     property    IsInitialized: boolean read FIsInitialized;
-    property    TopModalForm: TfpgWindowBase read FTopModalForm write FTopModalForm;
+    property    TopModalForm: TfpgWindowBase read GetTopModalForm;
     property    MainForm: TfpgWindowBase read FMainForm write FMainForm;
     property    Terminated: boolean read FTerminated write FTerminated;
   end;
@@ -1592,10 +1598,48 @@ end;
 
 { TfpgApplicationBase }
 
+function TfpgApplicationBase.GetTopModalForm: TfpgWindowBase;
+begin
+  Result := nil;
+  if (FModalFormStack <> nil) and (FModalFormStack.Count > 0) then
+    Result := TFpgWindowBase(FModalFormStack.Items[FModalFormStack.Count-1]);
+end;
+
 function TfpgApplicationBase.GetFontFaceList: TStringList;
 begin
   Result := DoGetFontFaceList;
 end;
 
+procedure TfpgApplicationBase.PushModalForm(AForm: TfpgWindowBase);
+var
+  StackIndex: Integer;
+begin
+  if FModalFormStack = nil then
+    Exit;
+  StackIndex := FModalFormStack.IndexOf(AForm);
+  if StackIndex = -1 then
+    FModalFormStack.Add(AForm)
+  //else move to top of stack?
+end;
+
+procedure TfpgApplicationBase.PopModalForm;
+begin
+  if FModalFormStack = nil then
+    Exit;
+  if FModalFormStack.Count > 0 then
+    FModalFormStack.Delete(FModalFormStack.Count-1);
+end;
+
+function TfpgApplicationBase.PrevModalForm: TfpgWindowBase;
+begin
+  Result := nil;
+  if FModalFormStack = nil then
+    Exit;
+  if FModalFormStack.Count < 2 then
+    Exit;
+
+  Result := TfpgWindowBase(FModalFormStack.Items[FModalFormStack.Count-2]);
+end;
+
 end.
 
diff --git a/src/corelib/x11/_netlayer.pas b/src/corelib/x11/_netlayer.pas
index 3eb5f326..31ea9d92 100644
--- a/src/corelib/x11/_netlayer.pas
+++ b/src/corelib/x11/_netlayer.pas
@@ -122,6 +122,7 @@ type
     UTF8_STRING: TAtom;
     FAtomSupported: array[TNetAtomEnum] of Boolean;
     FTimeStamp: LongInt;
+    function GetNetAtom(AAtom: TNetAtomEnum): TNetAtom;
     procedure InitNetAtoms;
     procedure UpdateSupportedAtoms;
   public
@@ -139,11 +140,12 @@ type
     function    WindowMove(const AWindow: TWindow; const AX, AY: Integer): Boolean;
     function    WindowSetSticky(const AWindow: TWindow; const AValue: Boolean): Boolean;
     function    WindowGetSticky(const AWindow: TWindow; out AValue: Boolean): Boolean;
-    procedure   WindowSetPID(const AWindow: TWindow; const APID: Integer);
+    procedure   WindowSetPID(const AWindow: TWindow; const APID: Cardinal);
     function    WindowGetFrameExtents(const AWindow: TWindow; out ATopHeight, ALeftWidth, ARightWidth, ABottomHeight: Integer): Boolean;
     procedure   WindowSetSupportPING(const AWindow: TWindow);
     procedure   WindowReplyToPING(const AWindow: TWindow; AClientMessage: PXClientMessageEvent);
     function    WindowGetState(const AWindow: TWindow; out AWindowState: TNetWindowStates): Boolean;
+    function    WindowSetModal(const AWindow: TWindow; const AValue: Boolean): Boolean;
     procedure   WindowDemandsAttention(const AWindow: TWindow);
     procedure   WindowSetSkipTaskbar(const AWindow: TWindow; const AValue: Boolean);
     procedure   WindowSetSkipPager(const AWindow: TWindow; const AValue: Boolean);
@@ -167,8 +169,12 @@ type
     procedure   SendRootWindowMessage(AMessage: PXEvent);
     procedure   SendRootWindowClientMessage(AMessage: PXClientMessageEvent);
     // property setting and getting routines
+    // the "WindowSetPropertyXX procedures replace the entire property so if
+    // the property is an array of items then you should copy the old property
+    // value and add the new item to the list and pass that list to the Set procedure
     function    WindowGetPropertyAtom(const AWindow: TWindow; AProperty: TAtom; var Count: Integer; var Atoms: PAtom): Boolean;
     procedure   WindowSetPropertyAtom(const AWindow: TWindow; AProperty: TAtom; Count: Integer; Atoms: PAtom);
+    procedure   WindowAppendPropertyAtom(const AWindow: TWindow; AProperty: TAtom; Count: Integer; Atoms: PAtom);
     function    WindowGetPropertyCardinal(const AWindow: TWindow; AProperty: TAtom; var Count: Integer; var Cards: PLongWord): Boolean;
     procedure   WindowSetPropertyCardinal(const AWindow: TWindow; AProperty: TAtom; Count: Integer; Cards: PLongInt);
     function    WindowGetPropertyWindow(const AWindow: TWindow; AProperty: TAtom; var Count: Integer; var Windows: PWindow): Boolean;
@@ -178,6 +184,8 @@ type
 
     constructor Create(ADisplay: PXDisplay);
     destructor  Destroy; override;
+    
+    property    NetAtom[AAtom: TNetAtomEnum]: TNetAtom read GetNetAtom;
   end;
   
   const
@@ -272,28 +280,33 @@ implementation
 
 procedure TNETWindowLayer.InitNetAtoms;
 var
-  NetAtom: TNetAtomEnum;
+  ANetAtom: TNetAtomEnum;
 begin
-  for NetAtom := Low(TNetAtomEnum) to High(TNetAtomEnum) do begin
-    FNetAtoms[NetAtom] := XInternAtom(FDisplay, PChar(NetAtomStr[NetAtom]), True)
+  for ANetAtom := Low(TNetAtomEnum) to High(TNetAtomEnum) do begin
+    FNetAtoms[ANetAtom] := XInternAtom(FDisplay, PChar(NetAtomStr[ANetAtom]), True)
   end;
   UTF8_STRING := XInternAtom(FDisplay, 'UTF8_STRING', True);
 end;
 
+function TNETWindowLayer.GetNetAtom(AAtom: TNetAtomEnum): TNetAtom;
+begin
+  Result := FNetAtoms[AAtom]
+end;
+
 procedure TNETWindowLayer.UpdateSupportedAtoms;
 var
   AtomCount: Integer;
   Atoms: PNetAtom;
   I: Integer;
-  NetAtom: TNetAtomEnum;
+  ANetAtom: TNetAtomEnum;
 begin
   if WindowGetPropertyAtom(FRootWindow, FNetAtoms[naSUPPORTED], AtomCount, Atoms) = False then;// Exit;
   //WriteLn('RootWindow Atom Count = ',AtomCount);
   FillChar(FAtomSupported, SizeOf(Boolean) * Length(FAtomSupported), 0);;
   for I := 0 to AtomCount-1 do begin
-    for NetAtom := Low(TNetAtomEnum) to High(TNetAtomEnum) do begin
-      if Atoms[I] = FNetAtoms[NetAtom] then begin
-        FAtomSupported[NetAtom] := True;
+    for ANetAtom := Low(TNetAtomEnum) to High(TNetAtomEnum) do begin
+      if Atoms[I] = FNetAtoms[ANetAtom] then begin
+        FAtomSupported[ANetAtom] := True;
         //WriteLn('Found ', NetAtomStr[NetAtom]);
       end;
     end;
@@ -540,8 +553,9 @@ begin
   if Result then AValue := nwsSticky in WinState;
 end;
 
-procedure TNETWindowLayer.WindowSetPID(const AWindow: TWindow; const APID: Integer);
+procedure TNETWindowLayer.WindowSetPID(const AWindow: TWindow; const APID: Cardinal);
 begin
+  WindowSetPropertyCardinal(AWindow, FNetAtoms[naWM_PID], 1, @APID);
 end;
 
 function TNETWindowLayer.WindowGetFrameExtents(const AWindow: TWindow; out
@@ -564,8 +578,12 @@ begin
 end;
 
 procedure TNETWindowLayer.WindowSetSupportPING(const AWindow: TWindow);
+var
+  WM_PROTOCOLS: TAtom;
 begin
+  //WM_PROTOCOLS := XInternAtom(FDisplay, 'WM_PROTOCOLS', True);
   WindowAddProtocol(AWindow, FNetAtoms[naWM_PING]);
+  //WindowAppendPropertyAtom(AWindow, WM_PROTOCOLS, 1, @FNetAtoms[naWM_PING]);
 end;
 
 procedure TNETWindowLayer.WindowReplyToPING(const AWindow: TWindow;
@@ -623,6 +641,7 @@ end;
 
 function TNETWindowLayer.ManagerIsValid: Boolean;
 begin
+  // if the window manager changes we need to refresh the list of atoms supported by it
   Result := False;  // ?????  Todo
 end;
 
@@ -663,6 +682,43 @@ begin
   XChangeProperty(FDisplay, AWindow, AProperty, XA_ATOM, 32, PropModeReplace, Pointer(Atoms), Count);
 end;
 
+procedure TNETWindowLayer.WindowAppendPropertyAtom(const AWindow: TWindow;
+  AProperty: TAtom; Count: Integer; Atoms: PAtom);
+var
+  AtomCount: Integer;
+  SetAtoms: PAtom;
+  I: Integer;
+  NewAtoms: array of TAtom;
+  NewCount: Integer;
+     function AtomInList(AAtom: PAtom): Boolean;
+     var
+       J: Integer;
+     begin
+       Result := False;
+       for J := 0 to AtomCount-1 do
+         if SetAtoms^ = AAtom^ then Exit(True);
+     end;
+begin
+  if WindowGetPropertyAtom(AWindow, AProperty, AtomCount, SetAtoms) = False then
+  begin
+    SetAtoms := nil;
+    AtomCount := 0;
+  end;
+  NewCount := AtomCount;
+  SetLength(NewAtoms, AtomCount + Count);
+  for I := 0 to Count-1 do
+  begin
+    if AtomInList(@Atoms[I]) = False then
+    begin
+      NewAtoms[NewCount] := Atoms[I];
+      Inc(NewCount);
+    end;
+  end;
+  if AtomCount > 0 then XFree(SetAtoms);
+  if NewCount > 0 then
+    WindowSetPropertyAtom(AWindow, AProperty, NewCount, @NewAtoms[0]);
+end;
+
 procedure TNETWindowLayer.WindowSetPropertyCardinal(const AWindow: TWindow;
   AProperty: TAtom; Count: Integer; Cards: PLongInt);
 begin
@@ -744,16 +800,29 @@ var
   Count: cint;
   Protocols: PAtom;
   NewProtocols: array of TAtom;
+  I: Integer;
 begin
+  Count := 0;
+  Protocols := nil;
+
   XGetWMProtocols(FDisplay, AWindow, @Protocols, @Count);
-  
   SetLength(NewProtocols, Count+1);
-  Move(Protocols[0], NewProtocols[0], SizeOf(TAtom)* Count);
+  if Protocols <> nil then
+  begin
+    for I := 0 to Count -1 do
+      if Protocols[I] = AProtocol then
+      begin
+        XFree(Protocols);
+        Exit;
+      end;
+    Move(Protocols[0], NewProtocols[0], SizeOf(TAtom)* Count);
+  end;
+
   NewProtocols[Count] := AProtocol;
-  
-  if Count > 0 then XFree(Protocols);
-  
-  XSetWMProtocols(FDisplay, AWindow, @NewProtocols, Count+1);
+  XSetWMProtocols(FDisplay, AWindow, @NewProtocols[0], Count+1);
+
+  if Count > 0 then
+    XFree(Protocols);
 end;
 
 function TNETWindowLayer.WindowGetAllowedActions(const AWindow: TWindow;
@@ -818,6 +887,15 @@ begin
     XFree(StateAtoms);
 end;
 
+function TNETWindowLayer.WindowSetModal(const AWindow: TWindow;
+  const AValue: Boolean): Boolean;
+begin
+  Result := FAtomSupported[naWM_STATE] and FAtomSupported[naWM_STATE_MODAL];
+  if not Result then
+    Exit;
+  WindowAppendPropertyAtom(AWindow, FNetAtoms[naWM_STATE], 1, @FNetAtoms[naWM_STATE_MODAL]);
+end;
+
 procedure TNETWindowLayer.WindowDemandsAttention(const AWindow: TWindow);
 var
   Msg: TXClientMessageEvent;
diff --git a/src/corelib/x11/gfx_x11.pas b/src/corelib/x11/gfx_x11.pas
index a03523b6..066274d4 100644
--- a/src/corelib/x11/gfx_x11.pas
+++ b/src/corelib/x11/gfx_x11.pas
@@ -13,6 +13,7 @@ uses
   Xlib,
   XUtil,
   x11_xft,
+  _netlayer,
   gfxbase,
   gfx_impl;
 
@@ -172,8 +173,7 @@ type
     xia_motif_wm_hints: TAtom;
     xia_wm_protocols: TAtom;
     xia_wm_delete_window: TAtom;
-    xia_wm_state: TAtom;
-    xia_wm_state_modal: TAtom;
+    netlayer: TNETWindowLayer;
     xia_targets: TAtom;
     InputMethod: PXIM;
     InputContext: PXIC;
@@ -199,7 +199,6 @@ uses
   fpgfx,
   gfx_widget,  {$Note This dependency to gfx_widget must be removed.}
   gui_form, // remove this!!!!!
-  _netlayer,
   cursorfont,
   gfx_popupwindow;
 
@@ -545,8 +544,8 @@ begin
   xia_motif_wm_hints    := XInternAtom(FDisplay, '_MOTIF_WM_HINTS', longbool(0));
   xia_wm_protocols      := XInternAtom(FDisplay, 'WM_PROTOCOLS', longbool(0));
   xia_wm_delete_window  := XInternAtom(FDisplay, 'WM_DELETE_WINDOW', longbool(0));
-  xia_wm_state          := XInternAtom(FDisplay, '_NET_WM_STATE', longbool(0));
-  xia_wm_state_modal    := XInternAtom(FDisplay, '_NET_WM_STATE_MODAL', longbool(0));
+
+  netlayer := TNETWindowLayer.Create(FDisplay);
 
   // for correct keyboard handling
   InputMethod := XOpenIM(FDisplay, nil, nil, nil);
@@ -563,7 +562,9 @@ end;
 
 destructor TfpgApplicationImpl.Destroy;
 begin
+  netlayer.Free;
   XCloseDisplay(FDisplay);
+  
   inherited Destroy;
 end;
 
@@ -870,16 +871,29 @@ begin
     X.ClientMessage:
         begin
           w := FindWindowByHandle(ev.xany.window);
-          if xapplication.TopModalForm <> nil then
+          // WM_PROTOCOLS message
+          if ev.xclient.message_type = xia_wm_protocols then
           begin
-            // This is ugly!!!!!!!!!!!!!!!
-            ew := TfpgWindowImpl(WidgetParentForm(TfpgWidget(w)));
-            if (ew <> nil) and (xapplication.TopModalForm <> ew) then
-              blockmsg := true;
-          end;
+            //WriteLn(XGetAtomName(FDisplay, TAtom(ev.xclient.data.l[0])));
+            if  (ev.xclient.data.l[0] = netlayer.NetAtom[naWM_PING]) then
+            begin
+              // always respond to pings or the wm will kill us
+              netlayer.WindowReplyToPING(w.FWinHandle, @ev.xclient);
+            end
+            else if ev.xclient.data.l[0] = xia_wm_delete_window then
+            begin
+              if xapplication.TopModalForm <> nil then
+              begin
+                // This is ugly!!!!!!!!!!!!!!!
+                ew := TfpgWindowImpl(WidgetParentForm(TfpgWidget(w)));
+                if (ew <> nil) and (xapplication.TopModalForm <> ew) then
+                  blockmsg := true;
+              end;
           
-          if not blockmsg then
-            fpgPostMessage(nil, FindWindowByHandle(ev.xany.window), FPGM_CLOSE);
+              if not blockmsg then
+                fpgPostMessage(nil, FindWindowByHandle(ev.xany.window), FPGM_CLOSE);
+             end;
+          end; // WM_PROTOCOLS
         end;
 
 
@@ -1009,6 +1023,7 @@ procedure TfpgWindowImpl.DoAllocateWindowHandle(AParent: TfpgWindowBase);
 var
   pwh: TfpgWinHandle;
   wh: TfpgWinHandle;
+  lmwh: TfpgWinHandle;
   attr: TXSetWindowAttributes;
   mask: longword;
   hints: TXSizeHints;
@@ -1039,6 +1054,15 @@ begin
     mask, @attr);
 
   FWinHandle := wh;
+    
+  // so newish window manager can close unresponsive programs
+  if AParent = nil then // is a toplevel window
+  begin
+    XSetWMProperties(fpgApplication.Display, FWinHandle, nil, nil, nil, 0, nil, nil, nil);
+    fpgApplication.netlayer.WindowSetPID(FWinHandle, GetProcessID);
+    fpgApplication.netlayer.WindowSetSupportPING(FWinHandle);
+  end;
+
   hints.flags := 0;
 
   if not (waAutoPos in FWindowAttributes) then
@@ -1071,13 +1095,33 @@ begin
   XSetWMNormalHints(xapplication.display, FWinHandle, @hints);
 
   if FWindowType <> wtChild then
-    XSetWMProtocols(xapplication.Display, FWinHandle, @(xapplication.xia_wm_delete_window),
-      1);// send close event instead of quitting the whole application...
+    // send close event instead of quitting the whole application...
+    fpgApplication.netlayer.WindowAddProtocol(FWinHandle, xapplication.xia_wm_delete_window);
 
   // for modal windows, this is necessary
-  if (FWindowType = wtModalForm) and (AParent <> nil) then
-    XSetTransientForHint(xapplication.display, FWinHandle, TfpgWindowImpl(AParent).WinHandle);
+  if FWindowType = wtModalForm then
+  begin
+    if Parent = nil then
+    begin
+      lmwh := 0;
+      if fpgApplication.PrevModalForm <> nil then
+        lmwh := TfpgWindowImpl(fpgApplication.PrevModalForm).WinHandle
+      else if fpgApplication.MainForm <> nil then
+        lmwh := TfpgWindowImpl(fpgApplication.MainForm).WinHandle;
+      if lmwh <> 0 then
+      begin
+        XSetTransientForHint(xapplication.display, FWinHandle, lmwh);
+        fpgApplication.netlayer.WindowSetModal(FWinHandle, True);
+      end;
+    end
+    else // Parent <> nil
+    begin
+      // this doesn't make any sense
 
+      //XSetTransientForHint(xapplication.display, FWinHandle, TfpgWindowImpl(Parent).FWinHandle);
+    end;
+  end;
+  
   XSelectInput(xapplication.Display, wh, KeyPressMask or KeyReleaseMask or
       ButtonPressMask or ButtonReleaseMask or
       EnterWindowMask or LeaveWindowMask or
@@ -1191,18 +1235,10 @@ begin
 end;
 
 procedure TfpgWindowImpl.DoSetWindowTitle(const atitle: string);
-var
-  netlayer: TNETWindowLayer;
 begin
   if FWinHandle <= 0 then
     Exit;
-
-  netlayer := TNETWindowLayer.Create(xapplication.display);
-  try
-    netlayer.WindowSetName(FWinHandle, PChar(ATitle));
-  finally
-    netlayer.Free;
-  end;
+  fpgApplication.netlayer.WindowSetName(FWinHandle, PChar(ATitle));
 end;
 
 constructor TfpgWindowImpl.Create(AOwner: TComponent);
diff --git a/src/gui/gui_form.pas b/src/gui/gui_form.pas
index 14291e15..8c1dd83d 100644
--- a/src/gui/gui_form.pas
+++ b/src/gui/gui_form.pas
@@ -43,7 +43,6 @@ type
     FOnShow: TNotifyEvent;
     procedure   SetBackgroundColor(const AValue: TfpgColor);
   protected
-    FPrevModalForm: TfpgWindowBase;
     FModalResult: integer;
     FParentForm: TfpgForm;
     FWindowPosition: TWindowPosition;
@@ -211,7 +210,6 @@ begin
   FMinWidth        := 32;
   FMinHeight       := 32;
   FModalResult     := 0;
-  FPrevModalForm   := nil;
 
   AfterCreate;
 end;
@@ -229,8 +227,8 @@ end;
 
 function TfpgForm.ShowModal: integer;
 begin
-  FPrevModalForm  := fpgApplication.TopModalForm;
-  fpgApplication.TopModalForm := self;
+  FWindowType := wtModalForm;
+  fpgApplication.PushModalForm(self);
   ModalResult     := 0;
 
   Show;
@@ -241,7 +239,7 @@ begin
     fpgWaitWindowMessage;
   until (ModalResult <> 0) or (not Visible);
 
-  fpgApplication.TopModalForm := FPrevModalForm;
+  fpgApplication.PopModalForm;
   Result := ModalResult;
 end;
 
@@ -312,7 +310,7 @@ end;
 procedure TfpgForm.Hide;
 begin
   if (fpgApplication.TopModalForm = self) then
-    fpgApplication.TopModalForm := FPrevModalForm;
+    fpgApplication.PopModalForm;
   HandleHide;
   if ModalResult = 0 then
     ModalResult := -1;