summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/corelib/fpgfx.pas3
-rw-r--r--src/corelib/gfxbase.pas48
-rw-r--r--src/corelib/x11/_netlayer.pas108
-rw-r--r--src/corelib/x11/gfx_x11.pas88
-rw-r--r--src/gui/gui_form.pas10
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;
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-10-16 20:41:03 +0000