From 224b0b1f552725154b4f86dd56d1962d000e83c3 Mon Sep 17 00:00:00 2001 From: drewski207 Date: Sat, 3 Nov 2007 17:40:50 +0000 Subject: * 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 --- src/corelib/x11/_netlayer.pas | 108 ++++++++++++++++++++++++++++++++++++------ src/corelib/x11/gfx_x11.pas | 88 ++++++++++++++++++++++++---------- 2 files changed, 155 insertions(+), 41 deletions(-) (limited to 'src/corelib/x11') 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); -- cgit v1.2.3-70-g09d2