From 6f7648609382d26d8d62d4b39d4ae6c6e701437a Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Mon, 2 Apr 2012 07:45:23 +0000 Subject: [PATCH] Patch from Giuliano Colla with a new timer, it is disabled by default because it crashes the test nonandroidtest git-svn-id: trunk@36513 - --- .../customdrawn/customdrawn_x11proc.pas | 150 ++++++++++++++++++ .../customdrawn/customdrawndefines.inc | 11 +- lcl/interfaces/customdrawn/customdrawnint.pas | 8 +- .../customdrawn/customdrawnobject_x11.inc | 101 +++++++++++- .../customdrawn/customdrawnproc.pas | 2 +- .../customdrawn/customdrawnwinapi_x11.inc | 18 ++- .../customdrawn/customdrawnwsforms_x11.inc | 44 ++++- 7 files changed, 305 insertions(+), 29 deletions(-) diff --git a/lcl/interfaces/customdrawn/customdrawn_x11proc.pas b/lcl/interfaces/customdrawn/customdrawn_x11proc.pas index 8d5bc001db..e6d522e9e1 100644 --- a/lcl/interfaces/customdrawn/customdrawn_x11proc.pas +++ b/lcl/interfaces/customdrawn/customdrawn_x11proc.pas @@ -2,6 +2,8 @@ unit customdrawn_x11proc; {$mode objfpc}{$H+} +{$I customdrawndefines.inc} + interface uses @@ -28,12 +30,36 @@ type ColorDepth: Byte; end; +{$ifdef CD_X11_UseNewTimer} + TWSTimerProc = procedure of object; + + { TCDX11Timer } + TCDX11Timer = class (TObject) + Next: TCDX11Timer; + Previous: TCDX11Timer; + Interval: Integer; + Expires: TDateTime; + func: TWSTimerProc; + constructor create (WSInterval: Integer; WSfunc: TWSTimerProc); + procedure Insert; + procedure Remove; + procedure Expired; + destructor destroy; + end; + +const + KMsToDateTime = 86400000; // # of milliseconds in a day +{$endif} + function RectToXRect(const ARect: TRect): TXRectangle; function XRectToRect(const ARect: TXRectangle): TRect; function XButtonToMouseButton(const XButton: cint; var MouseButton: TMouseButton): Boolean; function GetXEventName(Event: LongInt): String; implementation +{$ifdef CD_X11_UseNewTimer} +uses CustomDrawnInt; +{$endif} function RectToXRect(const ARect: TRect): TXRectangle; begin @@ -84,5 +110,129 @@ begin Result := '#' + IntToStr(Event); end; +{$ifdef CD_X11_UseNewTimer} +{ TCDX11Timer } + +constructor TCDX11Timer.create(WSInterval: Integer; WSfunc: TWSTimerProc); +{$ifdef Verbose_CD_X11_Timer} +var + lTInterval: Integer; + TDiff,TNow: TDateTime; +{$endif} +begin + Interval:= WSInterval; // Interval in ms + Func:= WSfunc; // OnTimeEvent + Expires:= Now + Interval/KMsToDateTime; // + {$ifdef Verbose_CD_X11_Timer} + TNow:= Now; + TDiff:= Expires - TNow; + lTInterval:=DateTimeToMilliseconds(Tdiff); + DebugLn(Format('X11_Timer create: Interval= %d, Calculated=%d',[Interval,lTInterval])); + {$endif} + Previous:= Nil; + Next:= Nil; +end; + +procedure TCDX11Timer.Insert; +var + lTimer,PTimer,NTimer: TCDX11Timer; +begin + {$ifdef Verbose_CD_X11_Timer} + DebugLn(Format('TCDX11Timer Insert: Interval := %d',[Interval])); + {$endif} + if CDWidgetSet.XTimerListHead = nil then begin// The list is empty + CDWidgetSet.XTimerListHead:= self; + Previous:=Nil; // This is the first and only timer + Next:=Nil; + end + else begin + PTimer:=nil; // previous in list + NTimer:=nil; // Next in list + lTimer := CDWidgetSet.XTimerListHead; + while lTimer.Expires <= Expires do begin + PTimer := ltimer; + if not assigned(lTimer.Next) then Break + else lTimer:= lTimer.Next; + end; + if PTimer<>nil then begin //We're not the first one + Previous := PTimer; + NTimer := PTimer.Next; + if Assigned(NTimer) then begin + Next := NTimer; + NTimer.Previous := self; + end + else Next := Nil; + PTimer.Next := self; + end + else begin // we're in first place. previous first becomes Next + NTimer := CDWidgetSet.XTimerListHead; + CDWidgetSet.XTimerListHead := Self; + NTimer.Previous := Self; + Next:= NTimer; + Previous := nil; + end; + end; + {$ifdef Verbose_CD_X11_Timer} + lTimer := CDWidgetSet.XTimerListHead; + while lTimer <> Nil do begin + DebugLn(Format('TCDX11Timer Insert results: Interval := %d',[lTimer.Interval])); + lTimer:= lTimer.Next; + end; + {$endif} +end; + +procedure TCDX11Timer.remove; +begin + {$ifdef Verbose_CD_X11_Timer} + DebugLn(Format('TCDX11Timer Remove: Interval := %d',[Interval])); + {$endif} + if Previous <> Nil then begin + if Next <> Nil then begin + Previous.Next := Next; + Next.Previous := Previous; + end + else Previous.Next:= Nil; + end + else begin + CDWidgetSet.XTimerListHead := Next; + if Next <> nil then begin + Next.Previous:= Nil; + end; + end; + Previous:= Nil; + Next := Nil; +end; + +procedure TCDX11Timer.Expired; +{$ifdef Verbose_CD_X11_Timer} +var + lInterval,lTInterval: Integer; + TDiff,TNow: TDateTime; +{$endif} +begin + Expires:= Expires+Interval/KMsToDateTime; // don't leak + {$ifdef Verbose_CD_X11_Timer} + TNow:= Now; + TDiff:= Expires - TNow; + lTInterval:=DateTimeToMilliseconds(Tdiff); + DebugLn(Format('X11_Timer Expired: Interval= %d, Calculated=%d',[Interval,lTInterval])); + {$endif} + Remove; // Remove from list Head + if func <> nil then + func(); // Execute OnTimer + Insert; // And insert again in right place +end; + +destructor TCDX11Timer.destroy; +begin + {$ifdef Verbose_CD_X11_Timer} + DebugLn(Format('TCDX11Timer Destroy: Interval := %d',[Interval])); + {$endif} + remove; + //Free; +end; + +{$endif} + end. diff --git a/lcl/interfaces/customdrawn/customdrawndefines.inc b/lcl/interfaces/customdrawn/customdrawndefines.inc index 521654efbf..0f00205b6f 100644 --- a/lcl/interfaces/customdrawn/customdrawndefines.inc +++ b/lcl/interfaces/customdrawn/customdrawndefines.inc @@ -48,14 +48,17 @@ // X11 options // ================== {$define CD_X11_NewNativePaint} +{$define CD_X11_UseLCL_MainLoop} +{.$define CD_X11_UseNewTimer} // ================== // Debug options // ================== {.$define VerboseCDPaintProfiler} +{.$define Verbose_CD_X11_Timer} +{.$define CD_Debug_TTF} {.$define VerboseCDDrawing} -{ $define VerboseCDBitmap} -{ $define VerboseCDForms} +{.$define VerboseCDBitmap} +{.$define VerboseCDForms} +{.$define VerboseCDX11WinAPI} {.$define VerboseCDAccessibility} -{ $define CD_Debug_TTF} - diff --git a/lcl/interfaces/customdrawn/customdrawnint.pas b/lcl/interfaces/customdrawn/customdrawnint.pas index 620eab7eb0..e0196d642a 100644 --- a/lcl/interfaces/customdrawn/customdrawnint.pas +++ b/lcl/interfaces/customdrawn/customdrawnint.pas @@ -36,7 +36,7 @@ uses // Platform specific {$ifdef CD_Windows}Windows, customdrawn_WinProc,{$endif} {$ifdef CD_Cocoa}MacOSAll, CocoaAll, customdrawn_cocoaproc, CocoaGDIObjects,{$endif} - {$ifdef CD_X11}X, XLib, XUtil, BaseUnix, customdrawn_x11proc, contnrs,{$ifdef CD_UseNativeText}xft, fontconfig,{$endif}{$endif} + {$ifdef CD_X11}X, XLib, XUtil, BaseUnix, customdrawn_x11proc, {contnrs,}{$ifdef CD_UseNativeText}xft, fontconfig,{$endif}{$endif} {$ifdef CD_Android} customdrawn_androidproc, jni, bitmap, log, keycodes, {$endif} @@ -166,6 +166,10 @@ type XConnections: TFPList; // Windows Info List XWindowList: TStringList; + // Timer queue head + {$ifdef CD_X11_UseNewTimer} + XTimerListHead: customdrawn_x11proc.TCDX11Timer; + {$endif} // Functions to keep track of windows needing repaint function CheckInvalidateWindowForX(XWIndowID: X.TWindow): Boolean; @@ -424,7 +428,7 @@ const {$ifdef CD_X11} const CDBackendNativeHandle = nhtX11TWindow; - + fpFD_SETSIZE = 1024; // As defined in deprecated Libc. Large enough for any practical purpose {$define CD_HasNativeFormHandle} {$endif} {$ifdef CD_Cocoa} diff --git a/lcl/interfaces/customdrawn/customdrawnobject_x11.inc b/lcl/interfaces/customdrawn/customdrawnobject_x11.inc index a8c197c62b..01a3417c1d 100644 --- a/lcl/interfaces/customdrawn/customdrawnobject_x11.inc +++ b/lcl/interfaces/customdrawn/customdrawnobject_x11.inc @@ -113,6 +113,9 @@ begin XConnections := TFPList.Create; XWindowList := TStringList.Create; + {$ifdef CD_X11_UseNewTimer} + XTimerListHead := nil; + {$endif} end; {------------------------------------------------------------------------------ @@ -202,6 +205,9 @@ procedure TCDWidgetSet.AppRun(const ALoop: TApplicationMainLoop); var DoBreakRun: Boolean = False; begin +{$IFDEF CD_X11_UseLCL_MainLoop} + Inherited; +{$ELSE} while (DoBreakRun = False) do begin if XPending(FDisplay) <= 0 then AppProcessInvalidates(); @@ -211,6 +217,7 @@ begin DoBreakRun := Application.Terminated; end; DoBreakRun := False; + {$ENDIF} end; (* @@ -246,7 +253,6 @@ end; Restore minimized whole application from taskbar ------------------------------------------------------------------------------} - procedure TCDWidgetSet.AppRestore; begin // Windows.SendMessage(FAppHandle, WM_SYSCOMMAND, SC_RESTORE, 0); @@ -346,6 +352,9 @@ var Sum: Integer; NewEvent: TXEvent; CurWindowInfo: TX11WindowInfo; + {$IFDEF VerboseCDPaintProfiler} + lMessageTime: Integer; + {$ENDIF} begin XNextEvent(FDisplay, @XEvent); @@ -438,6 +447,10 @@ begin {$ifdef VerboseCDEvents} DebugLn(Format('X11 event WM_PAINT - Window %d',[CurWindowInfo.Window])); {$endif} + {$IFDEF VerboseCDPaintProfiler} + lMessageTime:= DateTimeToMilliseconds(Now)-XClientEvent.data.l[1]; + DebugLn(Format('X11 event WM_PAINT - Window %d, Delay %d ms',[CurWindowInfo.Window,lMessageTime])); + {$ENDIF} TCDWSCustomForm.EvPaintEx(WindowEntry, CurWindowInfo); WindowUpdated(CurWindowInfo.Window); end @@ -531,23 +544,44 @@ var xconnnum, selectresult: integer; IsFirstTimeout: Boolean; AnyTimerProcessed: Boolean = False; + {$ifdef CD_X11_UseNewTimer} + lTimer,lNextTimer: TCDX11Timer; + {$else} lTimer: TCDTimer; + {$endif} lTimeoutInterval: Integer; // miliseconds i: Integer; begin IsFirstTimeout := True; + {$ifdef CD_X11_UseNewTimer} + if XTimerListHead = nil then lTimeoutInterval:= -1 + else begin + lTimer := XTimerListHead; + lTimeoutInterval:= trunc((lTimer.Expires-now)*KMsToDateTime); + if lTimeoutInterval < 0 then lTimeoutInterval:= 0; // we missed a timer: a quick look to + // pending messages then go process the timer + end; + {$else} lTimeoutInterval := GetSmallestTimerInterval(); - // Limit the maximum interval, even if only to process Application.OnIdle or + (*// Limit the maximum interval, even if only to process Application.OnIdle or // for general safety if (lTimeoutInterval < 0) or (lTimeoutInterval >= 1000) then lTimeoutInterval := 1000; // To avoid consuming too much CPU, if the interval is zero, act as if it was 1 - if lTimeoutInterval = 0 then lTimeoutInterval := 1; + if lTimeoutInterval = 0 then lTimeoutInterval := 1;*) + if lTimeoutInterval < 0 then lTimeoutInterval:= -1 ;// No timers - wait forever + {$endif} while not Application.Terminated do begin xconnnum := XConnectionNumber(FDisplay); - XFlush(FDisplay); + {--------------------------------------------------------------------------- + We should not call XFlush here to flush the output buffer because: + 1 - We may throw away unprocessed messages, calling XFlush before XPending + 2 - XPending already performs a flush of the output buffer + so calling XFlush is never required, except in very special cases + ---------------------------------------------------------------------------} + //XFlush(FDisplay); if XPending(FDisplay) > 0 then Exit; // We have a X message to process @@ -561,9 +595,33 @@ begin // Add all other X connections for i := 0 to XConnections.Count-1 do fpFD_SET(cint(PtrInt(XConnections.Items[i])), rfds); + {--------------------------------------------------------------------------- + Using here fpFD_SETSIZE (=1024) ensures that we will get a result for all + of our connections selected with fpFD_SET. Connection numbers are assigned + in sequence, including connections opened inside the application. Either + we keep track of the highest value in XConnections.Items, or we simply + use a large value. In old times one had to be more careful because a large + value gave a speed penalty, but in modern Unice's it doesn't make a difference. + Gnu Linux doesn't set an upper limit for that value, + ---------------------------------------------------------------------------} + selectresult := fpSelect(fpFD_SETSIZE, @rfds, nil, nil, lTimeoutInterval); - selectresult := fpSelect(xconnnum + 1, @rfds, nil, nil, lTimeoutInterval); - + {$ifdef CD_X11_UseNewTimer} + // Process all timers + while (lTimer <> nil) and (lTimer.Expires <= now) do begin + {$ifdef Verbose_CD_X11_Timer} + Debugln('This Timer %d',[lTimer.Interval]); + {$endif} + lNextTimer := lTimer.Next; + lTimer.Expired;// Exec OnTimer, and readjust list + AnyTimerProcessed := True; + lTimer := lNextTimer; + {$ifdef Verbose_CD_X11_Timer} + if (lTimer <> nil) then + Debugln('Next Timer %d',[lTimer.Interval]); + {$endif} + end; + {$else} // Process all timers for i := 0 to GetTimerCount()-1 do begin @@ -581,8 +639,13 @@ begin lTimer.NativeHandle := 0; end; end; - if AnyTimerProcessed then AppProcessInvalidates(); - + {$endif} + if AnyTimerProcessed then + {$IFDEF CD_X11_UseLCL_MainLoop} + selectresult:=1; + {$ELSE} + AppProcessInvalidates(); + {$ENDIF} if selectresult <> 0 then // We got a X event or the timeout happened Exit else @@ -645,6 +708,16 @@ end; The TimerCallBackProc calls the TimerFunc. ------------------------------------------------------------------------------} function TCDWidgetSet.CreateTimer(Interval: integer; TimerFunc: TWSTimerProc) : THandle; +{$ifdef CD_X11_UseNewTimer} +var + lTimer: TCDX11Timer; +begin + lTimer := TCDX11Timer.create(Interval,TimerFunc); + lTimer.Insert; + Result:= THandle(lTimer); +end; + +{$else} var lTimer: TCDTimer; begin @@ -654,6 +727,7 @@ begin AddTimer(lTimer); Result := THandle(lTimer); end; +{$endif} {------------------------------------------------------------------------------ function: DestroyTimer @@ -661,6 +735,16 @@ end; Returns: ------------------------------------------------------------------------------} function TCDWidgetSet.DestroyTimer(TimerHandle: THandle) : boolean; +{$ifdef CD_X11_UseNewTimer} +var + lTimer: TCDX11Timer absolute TimerHandle; +begin + if TimerHandle <> 0 then begin + lTimer.destroy; + end; +end; + +{$else} var lTimer: TCDTimer absolute TimerHandle; begin @@ -670,6 +754,7 @@ begin lTimer.Free; end; end; +{$endif} (* procedure TWinCEWidgetSet.HandleWakeMainThread(Sender: TObject); begin diff --git a/lcl/interfaces/customdrawn/customdrawnproc.pas b/lcl/interfaces/customdrawn/customdrawnproc.pas index 174cf3f6fc..de630b6a14 100644 --- a/lcl/interfaces/customdrawn/customdrawnproc.pas +++ b/lcl/interfaces/customdrawn/customdrawnproc.pas @@ -843,7 +843,7 @@ begin FontPath:= APath+Rslt.Name; {$ifdef CD_Debug_TTF} - DebugLn(Format('[FontsScanForTTF] font=', [FontPath])); + DebugLn(Format('[FontsScanForTTF] font=%s', [FontPath])); {$endif} // Work around for fonts which cause errors. See bug 21456 diff --git a/lcl/interfaces/customdrawn/customdrawnwinapi_x11.inc b/lcl/interfaces/customdrawn/customdrawnwinapi_x11.inc index df0475f9ba..6e8d9a0cee 100644 --- a/lcl/interfaces/customdrawn/customdrawnwinapi_x11.inc +++ b/lcl/interfaces/customdrawn/customdrawnwinapi_x11.inc @@ -637,6 +637,7 @@ var Doc: TXMLDocument; lFontDirectories: TStringList; i, j, FontsCount: cint; + l: Integer; lXFontPath: PPChar; APath, strTmp: string; XMLFontConfig, XMLDir: TDOMNode; @@ -648,9 +649,11 @@ begin lXFontPath := XGetFontPath(FDisplay, @FontsCount); for i:= 0 to FontsCount-1 do begin if Copy(lXFontPath[i],1,10) = 'catalogue:' then - APath:= PathDelim + Copy(lXFontPath[0],12,strlen(lXFontPath[0]))+ PathDelim + APath:= PathDelim + Copy(lXFontPath[0],12,strlen(lXFontPath[0])) else - APath:= lXFontPath[i] + PathDelim; + APath:= lXFontPath[i]; + l:= Length(APath); ; + if APath[l] <> PathDelim then APath:= APath+PathDelim; FontsScanDir(APath,AFontPaths,AFontList); end; XFreeFontPath(lXFontPath); @@ -3697,17 +3700,18 @@ end;*) {------------------------------------------------------------------------------ Function: GetSystemMetrics - Params: - Returns: Nothing - + Params: nIndex Integer + Returns: Integer + It returns the value for the System Metric requested in nIndex. + SM_.. constants are declared in LCLTypes ------------------------------------------------------------------------------} function TCDWidgetSet.GetSystemMetrics(nIndex: Integer): Integer; var R: TRect; begin - {$ifdef VerboseQtWinAPI} - WriteLn(Format('Trace:> [TQtWidgetSet.GetSystemMetrics] %d', [nIndex])); + {$ifdef VerboseCDX11WinAPI} + WriteLn(Format('Trace:> [TCDWidgetSet.GetSystemMetrics] %d', [nIndex])); {$endif} Result := 0; case nIndex of diff --git a/lcl/interfaces/customdrawn/customdrawnwsforms_x11.inc b/lcl/interfaces/customdrawn/customdrawnwsforms_x11.inc index 5a45b46eb1..c668521869 100644 --- a/lcl/interfaces/customdrawn/customdrawnwsforms_x11.inc +++ b/lcl/interfaces/customdrawn/customdrawnwsforms_x11.inc @@ -102,11 +102,18 @@ begin lx := APosition.x; ly := APosition.y; - XTranslateCoordinates(CDWidgetSet.FDisplay, lWindow, + {--------------------------------------------------------------------------- + We must not call XTranslate: + if applied to the root window, this makes X crazy, because it attempts + to translate the coordinates to themselves. + If applied to another window, it's wrong, because window position has already + been determined by LCL + ---------------------------------------------------------------------------} + {XTranslateCoordinates(CDWidgetSet.FDisplay, lWindow, XDefaultRootWindow(CDWidgetSet.FDisplay), lx, ly, @dx, @dy, @cw); lx := dx; - ly := dy; + ly := dy;} end else begin @@ -630,6 +637,7 @@ var reslt: Integer; {$IFDEF VerboseCDPaintProfiler} lTimeStart, lCDTimeEnd, lNativeTimeStart: TDateTime; + lTimeSend: Integer; {$ENDIF} begin {$IFDEF VerboseCDPaintProfiler} @@ -677,6 +685,9 @@ begin Event.message_type:= CDWidgetSet.FWMPaint; Event.format:= 32; // Must hold a culong for TXID Event.data.l[0]:= AWindowInfo.Window; + {$IFDEF VerboseCDPaintProfiler} + Event.data.l[1]:= DateTimeToMilliseconds(Now()); + {$ENDIF} reslt := XSendEvent(CDWidgetSet.FDisplay,AWindowInfo.Window,{Propagate=}True,0,@Event); // Painting will carried out from main event loop end; @@ -700,6 +711,7 @@ class procedure TCDWSCustomForm.EvPaintEx(const AWinControl: TWinControl; var lWidth, lHeight: Integer; lRawImage: TRawImage; + reslt: integer; begin lWidth := Round(AWinControl.width); lHeight := Round(AWinControl.height); @@ -734,20 +746,32 @@ end; class procedure TCDWSCustomForm.EvClientMessage(const AWinControl: TWinControl; AWindowInfo: TX11WindowInfo; var Event: TXClientMessageEvent); -var - CanClose: Boolean; begin if Event.message_type = CDWidgetset.FWMProtocols then begin if Event.Data.l[0] = CDWidgetset.FWMDeleteWindow then begin // Message results : 0 - do nothing, 1 - destroy window (felipe: is this comment correct? taken from lcl-cocoa) - CanClose:=LCLSendCloseQueryMsg(AWinControl)>0; - if {CanClose} True then // CanClose is returning false -> ToDo: find out why + {-------------------------------------------------------- + LCLSendCloseQueryMsg sends the message to TCustomForm.WMCloseQuery which + performs the close actions (query included) and always returns 0 + No way to know here if the close action will actually be performed. + -----------------------------------------------------------------------} + LCLSendCloseQueryMsg(AWinControl); + {---------------------------------------------------------------------- + No need to call LCLSendCloseUpMsg, because the form has already been closed, + if allowed by CanClose. + We can't ask X to destroy the window, because we don't know if CanClose was + true or false. Here we're just told by X that someone tried to close the + window, using WM functions. Moreover there are still hanging X events + to process. Either we implement AppTerminate, or we take yhe lazy + path and let the window be destroyed by the WM when the application terminates. + --------------------------------------------------------------------------} + (*if {CanClose} True then // CanClose is returning false -> ToDo: find out why begin LCLSendCloseUpMsg(AWinControl); XDestroyWindow(CDWidgetset.FDisplay, AWinControl.Handle); - end; + end;*) end else DebugLn(Format('LCL-CustomDrawn-X11: Unknown client protocol message: %d', [Event.Data.l[0]])); @@ -2700,7 +2724,13 @@ begin {$ifdef VerboseCDForms} DebugLn(Format('[TCDWSCustomForm.ShowHide] Visible=False AWinControl=%x', [PtrInt(AWinControl)])); {$endif} + XUnmapWindow(CDWidgetSet.FDisplay, lWindow); // Don't remove it here, wait for a X11 Destroy event + {--------------------------------------------------------------------------- + We will never get an X11 event, if we don't tell X11 to unmap the window! + Even if the WM attempts to close the window, it's the application which + triggers the actual operation. If CanClose is false, it doesn't do it. + ---------------------------------------------------------------------------} end; end;