From 9af0a719c433249529e39a5bb20330faff259ed5 Mon Sep 17 00:00:00 2001 From: mattias Date: Mon, 18 Aug 2003 13:26:06 +0000 Subject: [PATCH] renamed lazqueue to lazlinkedlist, patch from Jeroen git-svn-id: trunk@4495 - --- .gitattributes | 3 +- ide/lazarus.pp | 5 +- lcl/allunits.pp | 5 +- lcl/interfaces/gtk/gtkglobals.pp | 2 +- lcl/interfaces/gtk/gtkint.pp | 10 +- lcl/interfaces/gtk/gtkmsgqueue.pp | 237 +++++++++++++++++++++++++++ lcl/interfaces/gtk/gtkobject.inc | 175 +++++++------------- lcl/interfaces/gtk/gtkproc.pp | 8 +- lcl/interfaces/gtk/gtkwinapi.inc | 74 ++++----- lcl/lazlinkedlist.pas | 209 ++++++++++++++++++++++++ lcl/lazqueue.pp | 257 ------------------------------ 11 files changed, 548 insertions(+), 437 deletions(-) create mode 100644 lcl/interfaces/gtk/gtkmsgqueue.pp create mode 100644 lcl/lazlinkedlist.pas delete mode 100644 lcl/lazqueue.pp diff --git a/.gitattributes b/.gitattributes index 56e34f55e2..30555c151d 100644 --- a/.gitattributes +++ b/.gitattributes @@ -853,6 +853,7 @@ lcl/interfaces/gtk/gtkint.pp svneol=native#text/pascal lcl/interfaces/gtk/gtklistsl.inc svneol=native#text/pascal lcl/interfaces/gtk/gtklistslh.inc svneol=native#text/pascal lcl/interfaces/gtk/gtklistviewcallback.inc svneol=native#text/pascal +lcl/interfaces/gtk/gtkmsgqueue.pp svneol=native#text/pascal lcl/interfaces/gtk/gtkobject.inc svneol=native#text/pascal lcl/interfaces/gtk/gtkproc.inc svneol=native#text/pascal lcl/interfaces/gtk/gtkproc.pp svneol=native#text/pascal @@ -900,7 +901,7 @@ lcl/languages/lcl.fr.po svneol=native#text/plain lcl/languages/lcl.pl.po svneol=native#text/plain lcl/languages/lcl.po svneol=native#text/plain lcl/languages/lcl.ru.po svneol=native#text/plain -lcl/lazqueue.pp svneol=native#text/pascal +lcl/lazlinkedlist.pas svneol=native#text/pascal lcl/lcllinux.pp svneol=native#text/pascal lcl/lclmemmanager.pas svneol=native#text/pascal lcl/lclproc.pas svneol=native#text/pascal diff --git a/ide/lazarus.pp b/ide/lazarus.pp index 55c8db4010..2303f710e6 100644 --- a/ide/lazarus.pp +++ b/ide/lazarus.pp @@ -40,7 +40,7 @@ program Lazarus; {$R *.res} {$ENDIF} -{ $DEFINE IDE_MEM_CHECK} +{$DEFINE IDE_MEM_CHECK} uses //cmem, @@ -99,6 +99,9 @@ end. { $Log$ + Revision 1.51 2003/08/18 13:21:23 mattias + renamed lazqueue to lazlinkedlist, patch from Jeroen + Revision 1.50 2003/08/08 07:52:33 mattias deactivated memcheck diff --git a/lcl/allunits.pp b/lcl/allunits.pp index e9a4eacb48..1ca64122f4 100644 --- a/lcl/allunits.pp +++ b/lcl/allunits.pp @@ -28,7 +28,7 @@ uses // resource strings LCLStrConsts, // base classes - LazQueue, DynHashArray, LCLMemManager, AvgLvlTree, StringHashList, + LazLinkedList, DynHashArray, LCLMemManager, AvgLvlTree, StringHashList, ExtendedStrings, DynamicArray, UTrace, TextStrings, // base types and base functions LCLProc, LCLType, GraphMath, VCLGlobals, FileCtrl, LMessages, @@ -47,6 +47,9 @@ end. { ============================================================================= $Log$ + Revision 1.27 2003/08/18 13:21:23 mattias + renamed lazqueue to lazlinkedlist, patch from Jeroen + Revision 1.26 2003/08/01 09:44:52 mattias added SelectDirectory dialog diff --git a/lcl/interfaces/gtk/gtkglobals.pp b/lcl/interfaces/gtk/gtkglobals.pp index bacbac562e..087d371e0a 100644 --- a/lcl/interfaces/gtk/gtkglobals.pp +++ b/lcl/interfaces/gtk/gtkglobals.pp @@ -26,7 +26,7 @@ uses glib, gdk, gtk, {$ENDIF} LMessages, Controls, Forms, - VclGlobals, LCLLinux, LCLType, GTKDef, DynHashArray, LazQueue; + VclGlobals, LCLLinux, LCLType, GTKDef, DynHashArray, LazLinkedList; {$I dragicons.inc} diff --git a/lcl/interfaces/gtk/gtkint.pp b/lcl/interfaces/gtk/gtkint.pp index eeb1b3202c..7d22755c02 100644 --- a/lcl/interfaces/gtk/gtkint.pp +++ b/lcl/interfaces/gtk/gtkint.pp @@ -55,7 +55,7 @@ uses {$ENDIF} xlib, SysUtils, LMessages, Classes, Controls, Forms, LCLStrConsts, - VclGlobals, LCLProc, LCLLinux, LCLType, gtkDef, DynHashArray, LazQueue, + VclGlobals, LCLProc, LCLLinux, LCLType, gtkDef, DynHashArray, gtkMsgQueue, GraphType, GraphMath; @@ -65,8 +65,7 @@ type FKeyStateList: TList; // Keeps track of which keys are pressed FDeviceContexts: TDynHashArray;// hasharray of HDC FGDIObjects: TDynHashArray; // hasharray of PGdiObject - FMessageQueue: TLazQueue; // queue of PMsg - FPaintMessages: TDynHashArray; // hasharray of PLazQueueItem + FMessageQueue: TGtkMessageQueue; // queue of PMsg WaitingForMessages: boolean; FRCFilename: string; @@ -216,8 +215,6 @@ type procedure ResizeChild(Sender : TObject; Left,Top,Width,Height : Integer);virtual; procedure SetResizeRequest(Widget: PGtkWidget);virtual; procedure UnsetResizeRequest(Widget: PGtkWidget);virtual; - function HashPaintMessage(p: pointer): integer;virtual; - function FindPaintMessage(HandleWnd: HWnd): PLazQueueItem;virtual; procedure RemoveCallbacks(Sender : TObject); virtual; public // for gtk specific components: @@ -351,6 +348,9 @@ end. { ============================================================================= $Log$ + Revision 1.138 2003/08/18 13:21:23 mattias + renamed lazqueue to lazlinkedlist, patch from Jeroen + Revision 1.137 2003/08/13 16:18:58 mattias started check compiler options diff --git a/lcl/interfaces/gtk/gtkmsgqueue.pp b/lcl/interfaces/gtk/gtkmsgqueue.pp new file mode 100644 index 0000000000..4bcc9410b2 --- /dev/null +++ b/lcl/interfaces/gtk/gtkmsgqueue.pp @@ -0,0 +1,237 @@ +{*************************************************************************** + GtkMsgQueue - Messagequeue for Gtk interface + -------------------------------------------- + + Initial Revision : Thu Aug 16, 2003 + + + ***************************************************************************/ + + ***************************************************************************** + * * + * This file is part of the Lazarus Component Library (LCL) * + * * + * See the file COPYING.LCL, included in this distribution, * + * for details about the copyright. * + * * + * This program is distributed in the hope that it will be useful, * + * but WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * + * * + ***************************************************************************** +} +unit GtkMsgQueue; + +{$mode objfpc}{$H+} + +interface + +uses LazLinkedList, LCLType, LMessages, GtkGlobals, DynHashArray, GtkProc; + +type + TFinalPaintMessageFlag=(FPMF_None,FPMF_Internal,FPMF_All); + + TGtkMessageQueueItem=class(TLinkListitem) + private + fMsg : PMsg; + public + property Msg: PMsg read fMsg write fMsg; + function IsPaintMessage : boolean; + procedure DestroyMessage(ParFinalInternalOnly: TFinalPaintMessageFlag; + DisposeMessage: boolean); + constructor Create; + end; + + TGtkMessageQueue=class(TLinkList) + private + FPaintMessages: TDynHashArray; // Hash for paint messages + protected + function CreateItem : TLinkListItem;override; + function CalculateHash(ParWnd : Hwnd):integer; + function HashPaintMessage(p: pointer): integer; + public + constructor Create; + destructor destroy;override; + function FirstMessageItem : TGtkMessageQueueItem; + function LastMessageItem : TGtkMessageQueueItem; + function FirstMessage : PMsg; + function LastMessage : PMsg; + procedure AddMessage(ParMsg : PMsg); + procedure RemoveMessage(ParItem: TGtkMessageQueueItem; + ParFinalOnlyInternal: TFinalPaintMessageFlag; + DisposeMessage: boolean); + function FindPaintMessage(HandleWnd: HWnd): TGtkMessageQueueItem; + function HasPaintMessages:boolean; + function HasNonPaintMessages:boolean; + function NumberOfPaintMessages:integer; + function PopFirstMessage: PMsg; + end; + + +implementation + +{---(TGtkMessageQueueItem)----------------------} + +function TGtkMessageQueueItem.IsPaintMessage : boolean; +begin + Result := false; + if fMsg <> nil then begin + Result := (Msg^.Message = LM_Paint) or (Msg^.Message = LM_GtkPaint); + end; +end; + +constructor TGtkMessageQueueItem.Create; +begin + inherited Create; + fMsg := nil; +end; + +procedure TGtkMessageQueueItem.DestroyMessage( + ParFinalInternalOnly: TFinalPaintMessageFlag; DisposeMessage: boolean); +begin + if (ParFinalInternalOnly in [FPMF_All,FPMF_Internal]) + and (fMsg^.message = LM_GtkPaint) + then + FinalizePaintTagMsg(fMsg); + if DisposeMessage then + Dispose(fMsg); + fMsg := nil; +end; + +{---(TGtkMessageQueue )---------------------------} + +constructor TGtkMessageQueue.Create; +begin + inherited Create; + FPaintMessages := TDynHashArray.Create(-1); + FPaintMessages.OwnerHashFunction := @HashPaintMessage; +end; + +destructor TGtkMessageQueue.destroy; +begin + inherited Destroy; + fPaintMessages.destroy; +end; + +{------------------------------------------------------------------------------ + Function: FindPaintMessage + Params: a window handle + Returns: nil or a Paint Message to the widget + + Searches in FPaintMessages for a LM_PAINT message with HandleWnd. + ------------------------------------------------------------------------------} +function TGtkMessageQueue.FindPaintMessage(HandleWnd: HWnd): TGtkMessageQueueItem; +var h: integer; + HashItem: PDynHashArrayItem; +begin + h:= CalculateHash(HandleWnd); + HashItem:=FPaintMessages.GetHashItem(h); + if HashItem<>nil then begin + Result:=TGtkMessageQueueItem(HashItem^.Item); + if Result.Msg^.hWnd=HandleWnd then + exit; + HashItem:=HashItem^.Next; + while (HashItem<>nil) and (HashItem^.IsOverflow) do begin + + Result:=TGtkMessageQueueItem(HashItem^.Item); + if Result.Msg^.hWnd=HandleWnd then + exit; + HashItem:=HashItem^.Next; + + end; + end; + Result:=nil; +end; + + +function TGtkMessageQueue.HashPaintMessage(p: pointer): integer; +begin + result := CalculateHash(TGtkMessageQueueItem(p).Msg^.Hwnd); +end; + +function TGtkMessageQueue.CalculateHash(ParWnd : Hwnd):integer; +var + h:integer; +begin + h :=ParWnd; + if h<0 then h:=-h; + Result:=((h mod 5364329)+(h mod 17)) mod FPaintMessages.Capacity; +end; + +function TGtkMessageQueue.CreateItem : TLinkListItem; +begin + result := TGtkMessageQueueItem.Create; + result.ResetItem; +end; + +procedure TGtkMessageQueue.AddMessage(ParMsg : PMsg); +var + vLItem : TGtkMessageQueueItem; +begin + vlItem := TGtkMessageQueueItem(GetNewItem); + vlItem.fMsg := ParMsg; + AddAsLast(vlItem); + if vlItem.IsPaintMessage then fPaintMessages.Add(vlitem); +end; + +function TGtkMessageQueue.FirstMessageItem : TGtkMessageQueueItem; +begin + Result :=TGtkMessageQueueItem(First); +end; + +function TGtkMessageQueue.FirstMessage : PMsg; +begin + Result := nil; + if FirstMessageItem <> nil then Result := FirstMessageItem.fMsg; +end; + +function TGtkMessageQueue.LastMessageItem : TGtkMessageQueueItem; +begin + result:= TGtkMessageQueueItem(Last); +end; + +function TGtkMessageQueue.LastMessage : PMsg; +begin + Result := nil; + if LastMessageItem <> nil then result := LastMessageItem.fMsg; +end; + +{ Remove from queue and destroy message + ParItem : Queue Item for removel + ParFinalOnlyInterl : finalyze message only for LM_GtkPaint } +procedure TGtkMessageQueue.RemoveMessage(ParItem: TGtkMessageQueueItem; + ParFinalOnlyInternal: TFinalPaintMessageFlag; DisposeMessage: boolean); +begin + if (ParItem.IsPaintMessage) then + fPaintMessages.Remove(ParItem); + ParItem.DestroyMessage(ParFinalOnlyInternal,DisposeMessage); + Delete(ParItem); +end; + +function TGtkMessageQueue.HasPaintMessages:boolean; +begin + result := fPaintMessages.Count > 0; +end; + +function TGtkMessageQueue.NumberOfPaintMessages:integer; +begin + result := fPaintMessages.Count; +end; + +function TGtkMessageQueue.HasNonPaintMessages:boolean; +begin + result := fPaintMessages.Count <> count; +end; + +function TGtkMessageQueue.PopFirstMessage: PMsg; +var + vlItem : TGtkMessageQueueItem; +begin + vlItem := FirstMessageItem; + Result := vlItem.Msg; + RemoveMessage(vlItem,FPMF_none,false); +end; + +end. + + diff --git a/lcl/interfaces/gtk/gtkobject.inc b/lcl/interfaces/gtk/gtkobject.inc index b0d3cb9e59..f3602e7dc4 100644 --- a/lcl/interfaces/gtk/gtkobject.inc +++ b/lcl/interfaces/gtk/gtkobject.inc @@ -145,9 +145,7 @@ begin FDefaultFont:= nil; // messages - FMessageQueue := TLazQueue.Create; - FPaintMessages := TDynHashArray.Create(-1); - FPaintMessages.OwnerHashFunction := @HashPaintMessage; + FMessageQueue := TGtkMessageQueue.Create; WaitingForMessages := false; FWidgetsWithResizeRequest := TDynHashArray.Create(-1); FWidgetsWithResizeRequest.Options:= @@ -268,12 +266,12 @@ const 'gdiBitmap', 'gdiBrush', 'gdiFont', 'gdiPen', 'gdiRegion', 'gdiPalette'); var n: Integer; - p: PMsg; pTimerInfo : PGtkITimerinfo; GDITypeCount: array[TGDIType] of Integer; GDIType: TGDIType; HashItem: PDynHashArrayItem; - QueueItem, OldQueueItem: PLazQueueItem; + QueueItem : TGtkMessageQueueItem; + NextQueueItem : TGtkMessageQueueItem; begin FreeAllStyles; FreeGDKCursors; @@ -284,25 +282,18 @@ begin FGTKToolTips := nil; end; - // tidy up the messages - QueueItem:=FMessageQueue.First; + // tidy up the paint messages + QueueItem:=FMessageQueue.FirstMessageItem; while (QueueItem<>nil) do begin - p := PMsg(QueueItem^.Data); - if (p^.Message=LM_PAINT) or (p^.Message=LM_GtkPAINT) then begin - //writeln('[TgtkObject.Destroy] freeing unused paint message ',HexStr(p^.WParam,8)); - FPaintMessages.Remove(QueueItem); - FinalizePaintTagMsg(p); - Dispose(P); - OldQueueItem:=QueueItem; - QueueItem:=QueueItem^.Next; - FMessageQueue.Delete(OldQueueItem); - end else - QueueItem:=QueueItem^.Next; + NextQueueItem := TGtkMessageQueueItem(QueueItem.Next); + if QueueItem.IsPaintMessage then + fMessageQueue.RemoveMessage(QueueItem,FPMF_All,true); + QueueItem := NextQueueItem; end; - if FPaintMessages.Count>0 then begin + if fMessageQueue.HasPaintMessages then begin WriteLn(ProcName, Format(rsWarningUnremovedPaintMessages, - [IntToStr(FPaintMessages.Count)])); + [IntToStr(fMessageQueue.NumberOfPaintMessages)])); end; if (FDeviceContexts.Count > 0) @@ -348,15 +339,12 @@ begin WriteLN(ProcName,Format(' %s: %d', [GDITYPENAME[GDIType], GDITypeCount[GDIType]])); end; - if FMessageQueue.Count > 0 - then begin - WriteLN(ProcName, Format(rsWarningUnreleasedMessagesInQueue,[ - FMessageQueue.Count])); - while FMessageQueue.First<>nil do begin - p := PMsg(FMessageQueue.First^.Data); - Dispose(P); - FMessageQueue.Delete(FMessageQueue.First); - end; + + // tidy up messages + if FMessageQueue.Count > 0 then begin + WriteLN(ProcName, Format(rsWarningUnreleasedMessagesInQueue,[FMessageQueue.Count])); + while FMessageQueue.First<>nil do + fMessageQueue.RemoveMessage(fMessageQueue.FirstMessageItem,FPMF_All,true); end; n := FTimerData.Count; @@ -376,7 +364,6 @@ begin FreeAndNil(FWidgetsResized); FreeAndNil(FFixWidgetsResized); FMessageQueue.Free; - FPaintMessages.Free; FDeviceContexts.Free; FGDIObjects.Free; FKeyStateList.Free; @@ -1269,9 +1256,10 @@ procedure TgtkObject.HandleEvents; end; var - Msg: TMsg; - p: pMsg; - IsPaintMessage: boolean; + + vlItem : TGtkMessageQueueItem; + vlMsg : PMSg; + begin repeat // send cached LCL messages to the gtk @@ -1283,38 +1271,33 @@ begin // send cached gtk messages to the lcl SendCachedGtkMessages; - + // then handle our own messages - with FMessageQueue do begin - while First<>nil do - begin - // fetch first message - p := PMsg(First^.Data); - Msg := p^; - IsPaintMessage:=(Msg.Message=LM_PAINT) or (Msg.Message=LM_GtkPaint); + while true do begin + // fetch first message + vlItem := fMessageQueue.FirstMessageItem; + if vlItem = nil then break; - // remove message from queue - if IsPaintMessage then begin - // paint messages are the most expensive messages in the LCL, - // therefore they are sent always after all other - if Count>FPaintMessages.Count then begin - // there are non paint messages -> keep paint message back - MoveToLast(First); - continue; - end else begin - // there are only paint messages left in the queue - // -> check other queues - if PendingGtkMessagesExists then break; - end; - FPaintMessages.Remove(First); + // remove message from queue + if vlItem.IsPaintMessage then begin + // paint messages are the most expensive messages in the LCL, + // therefore they are sent always after all other + if fMessageQueue.HasNonPaintMessages then begin + // there are non paint messages -> keep paint message back + fMessageQueue.MoveToLast(FMessageQueue.First); + continue; + end else begin + // there are only paint messages left in the queue + // -> check other queues + if PendingGtkMessagesExists then break; end; - Delete(First); - - // Send message - with Msg do - SendMessage(hWND, Message, WParam, LParam); - Dispose(p); end; + + vlMsg:=fMessageQueue.PopFirstMessage; + + // Send message + with vlMsg^ do SendMessage(hWND, Message, WParam, LParam); + Dispose(vlMsg); end; // proceed until all messages are handled @@ -4274,7 +4257,8 @@ end; procedure TGTKObject.DestroyLCLComponent(Sender : TObject); var handle: hwnd; // handle of sender - QueueItem, OldQueueItem: PLazQueueItem; + QueueItem : TGtkMessageQueueItem; + NextItem : TGtkMessageQueueItem; MsgPtr: PMsg; Widget: PGtkWidget; FixWidget: PGtkWidget; @@ -4376,22 +4360,13 @@ begin //writeln('>>> LM_DESTROY END ',Sender.Classname,' Sender=',HexStr(Cardinal(Sender),8),' Handle=',HexStr(Cardinal(Handle),8)); // remove all remaining messages to this component - QueueItem:=FMessageQueue.First; + QueueItem:=FMessageQueue.FirstMessageItem; while (QueueItem<>nil) do begin - MsgPtr := PMsg(QueueItem^.Data); - if (MsgPtr^.hWnd=Handle) then begin - // remove message - if (MsgPtr^.Message=LM_PAINT) or (MsgPtr^.Message=LM_GtkPAINT) then begin - FPaintMessages.Remove(QueueItem); - FinalizePaintTagMsg(MsgPtr); - end; - Dispose(MsgPtr); - OldQueueItem:=QueueItem; - QueueItem:=QueueItem^.Next; - FMessageQueue.Delete(OldQueueItem); - end else begin - QueueItem:=QueueItem^.Next; - end; + MsgPtr := QueueItem.Msg; + NextItem := TGtkMessagequeueItem(QueueItem.Next); + if (MsgPtr^.hWnd=Handle) then + fMessageQueue.RemoveMessage(QueueItem,FPMF_All,true); + QueueItem := NextItem; end; // mouse click messages @@ -7584,51 +7559,8 @@ begin end; end; -{------------------------------------------------------------------------------ - Function: HashPaintMessage - Params: a PaintMessage in the Message queue (= PLazQueueItem) - Returns: a hash index - Calculates a hash of the handle in the PaintMessage which is used by the - FPaintMessages (which is a TDynHashArray). - ------------------------------------------------------------------------------} -function TgtkObject.HashPaintMessage(p: pointer): integer; -var h: integer; -begin - h:=PMsg(PLazQueueItem(p)^.Data)^.hWnd; - if h<0 then h:=-h; - Result:=((h mod 5364329)+(h mod 17)) mod FPaintMessages.Capacity; -end; -{------------------------------------------------------------------------------ - Function: FindPaintMessage - Params: a window handle - Returns: nil or a Paint Message to the widget - - Searches in FPaintMessages for a LM_PAINT message with HandleWnd. - ------------------------------------------------------------------------------} -function TgtkObject.FindPaintMessage(HandleWnd: HWnd): PLazQueueItem; -var h: integer; - HashItem: PDynHashArrayItem; -begin - h:=HandleWnd; - if h<0 then h:=-h; - h:=((h mod 5364329)+(h mod 17)) mod FPaintMessages.Capacity; - HashItem:=FPaintMessages.GetHashItem(h); - if HashItem<>nil then begin - Result:=PLazQueueItem(HashItem^.Item); - if PMsg(Result^.Data)^.hWnd=HandleWnd then - exit; - HashItem:=HashItem^.Next; - while (HashItem<>nil) and (HashItem^.IsOverflow) do begin - Result:=PLazQueueItem(HashItem^.Item); - if PMsg(Result^.Data)^.hWnd=HandleWnd then - exit; - HashItem:=HashItem^.Next; - end; - end; - Result:=nil; -end; {------------------------------------------------------------------------------ TgtkObject SetResizeRequest @@ -8038,6 +7970,9 @@ end; { ============================================================================= $Log$ + Revision 1.399 2003/08/18 13:21:23 mattias + renamed lazqueue to lazlinkedlist, patch from Jeroen + Revision 1.398 2003/08/15 14:01:20 mattias combined lazconf things for unix diff --git a/lcl/interfaces/gtk/gtkproc.pp b/lcl/interfaces/gtk/gtkproc.pp index ea55204281..5afbec8655 100644 --- a/lcl/interfaces/gtk/gtkproc.pp +++ b/lcl/interfaces/gtk/gtkproc.pp @@ -36,10 +36,10 @@ uses glib, gdk, gtk, {$Ifndef NoGdkPixbufLib}gdkpixbuf,{$EndIf} {$ENDIF} LMessages, Controls, Forms, VclGlobals, LCLProc, - LCLStrConsts, LCLLinux, LCLType, gtkDef, DynHashArray, LazQueue, GraphType, - GraphMath, Graphics, Buttons, Menus, GTKWinApiWindow, StdCtrls, ComCtrls, - CListBox, KeyMap, Calendar, Arrow, Spin, CommCtrl, ExtCtrls, Dialogs, - FileCtrl, LResources, Math, GTKGlobals; + LCLStrConsts, LCLLinux, LCLType, gtkDef, DynHashArray, LazLinkedList, + GraphType, GraphMath, Graphics, Buttons, Menus, GTKWinApiWindow, StdCtrls, + ComCtrls, CListBox, KeyMap, Calendar, Arrow, Spin, CommCtrl, ExtCtrls, + Dialogs, FileCtrl, LResources, Math, GTKGlobals; {$IFDEF gtk2} diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index 98ab26a4e8..6df2f3de58 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -5789,27 +5789,17 @@ end; function TgtkObject.PeekMessage(var lpMsg: TMsg; Handle : HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): Boolean; var - AMessage: PMsg; + vlItem : TGtkMessageQueueItem; begin //TODO Filtering - - Result := FMessageQueue.Count > 0; - if Result - then begin - AMessage := FMessageQueue.First^.Data; - lpMsg := AMessage^; - if (wRemoveMsg and PM_REMOVE) = PM_REMOVE - then begin - if (AMessage^.Message=LM_PAINT) or (AMessage^.Message=LM_GtkPAINT) then - begin - FPaintMessages.Remove(FMessageQueue.First); - // don't free the DC, this is work for the caller. - // Free the data of our internal gtk messages - if AMessage^.Message=LM_GtkPAINT then - FinalizePaintTagMsg(AMessage); - end; - FMessageQueue.Delete(FMessageQueue.First); - end; + writeln('Peek !!!' ); + vlItem := fMessageQueue.FirstMessageItem; + Result := vlItem <> nil; + + if Result then begin + lpMsg := vlItem.Msg^; + if (wRemoveMsg and PM_REMOVE) = PM_REMOVE then + fMessageQueue.RemoveMessage(vlItem,FPMF_Internal,true); end; end; @@ -6043,7 +6033,7 @@ function TGTKObject.PostMessage(Handle: HWND; Msg: Cardinal; wParam: LongInt; Parent:=Target.Parent; while Parent<>nil do begin ParentHandle:=Parent.Handle; - if FindPaintMessage(ParentHandle)<>nil then begin + if fMessageQueue.FindPaintMessage(ParentHandle)<>nil then begin Result:=true; end; Parent:=Parent.Parent; @@ -6051,27 +6041,17 @@ function TGTKObject.PostMessage(Handle: HWND; Msg: Cardinal; wParam: LongInt; end; end; - function ExtractPaintMessageForHandle(hnd: HWnd): PMsg; - var - OldPaintMessage: PLazQueueItem; - begin - Result:=nil; - if (hnd=0) then exit; - OldPaintMessage:=FindPaintMessage(hnd); - if OldPaintMessage<>nil then begin - // delete paint message from queue - Result:=PMsg(OldPaintMessage^.Data); - FPaintMessages.Remove(OldPaintMessage); - FMessageQueue.Delete(OldPaintMessage); - end; - end; - - procedure CombinePaintMessages(NewMsg, OldMsg: PMsg); + procedure CombinePaintMessages(NewMsg:PMsg); // combine NewMsg and OldMsg paint message into NewMsg and free OldMsg var + vlItem : TGtkMessageQueueItem; NewData: TLMGtkPaintData; OldData: TLMGtkPaintData; + OldMsg : PMsg; begin + vlItem := fMessageQueue.FindPaintMessage(NewMsg^.Hwnd); + if vlItem = nil then exit; + OldMsg := vlItem.Msg; if OldMsg=nil then exit; if (NewMsg^.Message=LM_PAINT) or (OldMsg^.Message=LM_PAINT) then begin // LM_PAINT means: repaint all @@ -6096,13 +6076,11 @@ function TGTKObject.PostMessage(Handle: HWND; Msg: Cardinal; wParam: LongInt; NewData.Rect.Bottom:=Max(NewData.Rect.Bottom,OldData.Rect.Bottom); end; end; - FinalizePaintTagMsg(OldMsg); - Dispose(OldMsg); + fMessageQueue.RemoveMessage(vlItem,FPMF_All,true); end; var AMessage: PMsg; - OldPaintMsg: PMsg; begin Result := True; @@ -6114,25 +6092,24 @@ begin // Message^.Time := if (AMessage^.Message=LM_PAINT) or (AMessage^.Message=LM_GtkPAINT) then begin + { Obsolete, because InvalidateRectangle now works. + // paint messages are the most expensive messages in the LCL // A paint message to a control will also repaint all child controls. // -> check if there is already a paint message for one of its parents // if yes, then skip this message - {if ParentPaintMessageInQueue then begin + if ParentPaintMessageInQueue then begin FinalizePaintTagMsg(AMessage^); exit; end;} // delete old paint message to this widget, // so that the widget repaints only once - OldPaintMsg:=ExtractPaintMessageForHandle(Handle); - CombinePaintMessages(AMessage,OldPaintMsg); - FMessageQueue.AddLast(AMessage); - FPaintMessages.Add(FMessageQueue.Last); - end else begin - FMessageQueue.AddLast(AMessage); - end; + CombinePaintMessages(AMessage); + end ; + + FMessageQueue.AddMessage(AMessage); end; {------------------------------------------------------------------------------ @@ -8753,6 +8730,9 @@ end; { ============================================================================= $Log$ + Revision 1.268 2003/08/18 13:21:23 mattias + renamed lazqueue to lazlinkedlist, patch from Jeroen + Revision 1.267 2003/08/16 15:29:56 mattias fixed TBitmap.GetHandle diff --git a/lcl/lazlinkedlist.pas b/lcl/lazlinkedlist.pas new file mode 100644 index 0000000000..49f419f37b --- /dev/null +++ b/lcl/lazlinkedlist.pas @@ -0,0 +1,209 @@ +{ + ***************************************************************************** + * * + * This file is part of the Lazarus Component Library (LCL) * + * * + * See the file COPYING.LCL, included in this distribution, * + * for details about the copyright. * + * * + * This program is distributed in the hope that it will be useful, * + * but WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * + * * + ***************************************************************************** + + Authors: Mattias Gaertner, Jeroen van Iddekinge + + Abstract: + Defines the simple double connected queue TLinkList. + It supports Adding, Deleting, getting First and getting Last in O(1). + Finding can be done in time O(n). +} +unit LazLinkedList; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +type + TLinkListItem = class + Next : TLinkListItem; + Prior : TLinkListItem; + procedure ResetItem; virtual; + end; + + TLinkList = class + private + FFirstFree: TLinkListItem; + FFreeCount: integer; + FFirst: TLinkListItem; + FLast: TLinkListItem; + FCount: integer; + procedure DisposeItem(AnItem: TLinkListItem); + procedure Unbind(AnItem: TLinkListItem); + protected + function CreateItem: TLinkListItem; virtual; abstract; + function GetNewItem: TLinkListItem; + procedure AddAsLast(AnItem: TLinkListItem); + public + property First: TLinkListItem read FFirst; + property Last: TLinkListItem read FLast; + property Count: integer read FCount; + procedure Delete(AnItem: TLinkListItem); + procedure MoveToLast(AnItem: TLinkListItem); + procedure Clear; + function ConsistencyCheck: integer; + constructor Create; + destructor Destroy; override; + end; + +implementation + +{ TLinkList } + +procedure TLinkListItem.ResetItem; +begin + Next := nil; + Prior := nil; +end; + +constructor TLinkList.Create; +begin + inherited Create; +end; + +destructor TLinkList.Destroy; +var AnItem: TLinkListItem; +begin + Clear; + // clear the free list + while FFirstFree<>nil do begin + AnItem:=FFirstFree; + FFirstFree:=AnItem.Next; + AnItem.Destroy; + end; + inherited Destroy; +end; + +procedure TLinkList.Delete(AnItem: TLinkListItem); +begin + if AnItem=nil then exit; + Unbind(AnItem); + AnItem.Destroy; +end; + +procedure TLinkList.MoveToLast(AnItem: TLinkListItem); +begin + if AnItem=nil then exit; + Unbind(AnItem); + AddAsLast(AnItem); +end; + +procedure TLinkList.Clear; +begin + while First<>nil do Delete(First); +end; + +function TLinkList.GetNewItem: TLinkListItem; +begin + if FFirstFree<>nil then begin + Result:=FFirstFree; + FFirstFree:=FFirstFree.Next; + if FFirstFree<>nil then + FFirstFree.Prior:=nil; + dec(FFreeCount); + end else begin + Result := CreateItem; + end; + Result.Next:=nil; + Result.Prior:=nil; +end; + +procedure TLinkList.DisposeItem(AnItem: TLinkListItem); +var i: integer; +begin + if FFreeCount<=2*FCount then begin + AnItem.ResetItem; + AnItem.Next:=FFirstFree; + FFirstFree:=AnItem; + if AnItem.Next<>nil then AnItem.Next.Prior:=AnItem; + inc(FFreeCount); + end else begin + AnItem.Destroy; + if (FCount+5)<2*FFreeCount then begin + for i:=1 to 2 do begin + if FFirstFree<>nil then begin + AnItem:=FFirstFree; + FFirstFree:=FFirstFree.Next; + if FFirstFree<>nil then + FFirstFree.Prior:=nil; + AnItem.Destroy; + dec(FFreeCount); + end; + end; + end; + end; +end; + +procedure TLinkList.Unbind(AnItem: TLinkListItem); +begin + if AnItem=nil then exit; + if FFirst=AnItem then FFirst:=FFirst.Next; + if FLast=AnItem then FLast:=FLast.Prior; + if AnItem.Prior<>nil then AnItem.Prior.Next:=AnItem.Next; + if AnItem.Next<>nil then AnItem.Next.Prior:=AnItem.Prior; + AnItem.Prior:=nil; + AnItem.Next:=nil; + dec(FCount); +end; + +procedure TLinkList.AddAsLast(AnItem: TLinkListItem); +begin + AnItem.Prior:=FLast; + AnItem.Next:=nil; + FLast:=AnItem; + if AnItem.Prior<>nil then + AnItem.Prior.Next:=AnItem + else + FFirst:=AnItem; + inc(FCount); +end; + +function TLinkList.ConsistencyCheck: integer; +var RealCount: integer; + AnItem: TLinkListItem; +begin + // test free list + RealCount:=0; + AnItem:=FFirstFree; + while AnItem<>nil do begin + inc(RealCount); + AnItem:=AnItem.Next; + end; + if FFreeCount<>RealCount then begin + Result:=-1; exit; + end; + // test items + RealCount:=0; + AnItem:=FFirst; + while AnItem<>nil do begin + if (AnItem.Next<>nil) and (AnItem.Next.Prior<>AnItem) then begin + Result:=-2; exit; + end; + if (AnItem.Prior<>nil) and (AnItem.Prior.Next<>AnItem) then begin + Result:=-3; exit; + end; + inc(RealCount); + AnItem:=AnItem.Next; + end; + if FCount<>RealCount then begin + Result:=-4; exit; + end; + Result:=0; +end; + +end. + diff --git a/lcl/lazqueue.pp b/lcl/lazqueue.pp deleted file mode 100644 index 594a519460..0000000000 --- a/lcl/lazqueue.pp +++ /dev/null @@ -1,257 +0,0 @@ -{ - Author: Mattias Gaertner - - ***************************************************************************** - * * - * This file is part of the Lazarus Component Library (LCL) * - * * - * See the file COPYING.LCL, included in this distribution, * - * for details about the copyright. * - * * - * This program is distributed in the hope that it will be useful, * - * but WITHOUT ANY WARRANTY; without even the implied warranty of * - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * - * * - ***************************************************************************** - - Abstract: - Defines the simple double connected queue TLazQueue. - A Queue stores a set of pointers and supports Adding, Deleting, getting - First and getting Last in O(1). - Finding can be done in time O(n). -} -unit LazQueue; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils; - -type - PLazQueueItem = ^TLazQueueItem; - TLazQueueItem = record - Next, Prior: PLazQueueItem; - Data: Pointer; - end; - - TLazQueue = class - private - FFirstFree: PLazQueueItem; - FFreeCount: integer; - FFirst: PLazQueueItem; - FLast: PLazQueueItem; - FCount: integer; - function GetNewItem: PLazQueueItem; - procedure DisposeItem(AnItem: PLazQueueItem); - procedure Unbind(AnItem: PLazQueueItem); - procedure AddAsLast(AnItem: PLazQueueItem); - public - property First: PLazQueueItem read FFirst; - property Last: PLazQueueItem read FLast; - function FirstData: Pointer; - function LastData: Pointer; - property Count: integer read FCount; - procedure AddLast(Data: Pointer); - procedure Delete(AnItem: PLazQueueItem); - procedure MoveToLast(AnItem: PLazQueueItem); - function Find(Data: Pointer): PLazQueueItem; - procedure Clear; - function ConsistencyCheck: integer; - procedure WriteDebugReport; - constructor Create; - destructor Destroy; override; - end; - -implementation - -{ TLazQueue } - -constructor TLazQueue.Create; -begin - inherited Create; -end; - -destructor TLazQueue.Destroy; -var AnItem: PLazQueueItem; -begin - Clear; - // clear the free list - while FFirstFree<>nil do begin - AnItem:=FFirstFree; - FFirstFree:=AnItem^.Next; - Dispose(AnItem); - end; - inherited Destroy; -end; - -function TLazQueue.FirstData: Pointer; -begin - if FFirst<>nil then - Result:=FFirst^.Data - else - Result:=nil; -end; - -function TLazQueue.LastData: Pointer; -begin - if FLast<>nil then - Result:=FLast^.Data - else - Result:=nil; -end; - -procedure TLazQueue.AddLast(Data: Pointer); -var NewItem: PLazQueueItem; -begin - NewItem:=GetNewItem; - NewItem^.Data:=Data; - AddAsLast(NewItem); -end; - -procedure TLazQueue.Delete(AnItem: PLazQueueItem); -begin - if AnItem=nil then exit; - Unbind(AnItem); - DisposeItem(AnItem); -end; - -procedure TLazQueue.MoveToLast(AnItem: PLazQueueItem); -begin - if AnItem=nil then exit; - Unbind(AnItem); - AddAsLast(AnItem); -end; - -procedure TLazQueue.Clear; -begin - while First<>nil do Delete(First); -end; - -function TLazQueue.GetNewItem: PLazQueueItem; -begin - if FFirstFree<>nil then begin - Result:=FFirstFree; - FFirstFree:=FFirstFree^.Next; - if FFirstFree<>nil then - FFirstFree^.Prior:=nil; - dec(FFreeCount); - end else begin - New(Result); - end; - Result^.Next:=nil; - Result^.Prior:=nil; - Result^.Data:=nil; -end; - -procedure TLazQueue.DisposeItem(AnItem: PLazQueueItem); -var i: integer; -begin - if FFreeCount<=2*FCount then begin - AnItem^.Next:=FFirstFree; - AnItem^.Prior:=nil; - AnItem^.Data:=nil; - FFirstFree:=AnItem; - if AnItem^.Next<>nil then AnItem^.Next^.Prior:=AnItem; - inc(FFreeCount); - end else begin - Dispose(AnItem); - if (FCount+5)<2*FFreeCount then begin - for i:=1 to 2 do begin - if FFirstFree<>nil then begin - AnItem:=FFirstFree; - FFirstFree:=FFirstFree^.Next; - if FFirstFree<>nil then - FFirstFree^.Prior:=nil; - Dispose(AnItem); - dec(FFreeCount); - end; - end; - end; - end; -end; - -procedure TLazQueue.Unbind(AnItem: PLazQueueItem); -begin - if AnItem=nil then exit; - if FFirst=AnItem then FFirst:=FFirst^.Next; - if FLast=AnItem then FLast:=FLast^.Prior; - if AnItem^.Prior<>nil then AnItem^.Prior^.Next:=AnItem^.Next; - if AnItem^.Next<>nil then AnItem^.Next^.Prior:=AnItem^.Prior; - AnItem^.Prior:=nil; - AnItem^.Next:=nil; - dec(FCount); -end; - -procedure TLazQueue.AddAsLast(AnItem: PLazQueueItem); -begin - AnItem^.Prior:=FLast; - AnItem^.Next:=nil; - FLast:=AnItem; - if AnItem^.Prior<>nil then - AnItem^.Prior^.Next:=AnItem - else - FFirst:=AnItem; - inc(FCount); -end; - -function TLazQueue.Find(Data: Pointer): PLazQueueItem; -begin - Result:=FFirst; - while (Result<>nil) do - if Result^.Data=Data then exit; -end; - -function TLazQueue.ConsistencyCheck: integer; -var RealCount: integer; - AnItem: PLazQueueItem; -begin - // test free list - RealCount:=0; - AnItem:=FFirstFree; - while AnItem<>nil do begin - inc(RealCount); - AnItem:=AnItem^.Next; - end; - if FFreeCount<>RealCount then begin - Result:=-1; exit; - end; - // test items - RealCount:=0; - AnItem:=FFirst; - while AnItem<>nil do begin - if (AnItem^.Next<>nil) and (AnItem^.Next^.Prior<>AnItem) then begin - Result:=-2; exit; - end; - if (AnItem^.Prior<>nil) and (AnItem^.Prior^.Next<>AnItem) then begin - Result:=-3; exit; - end; - inc(RealCount); - AnItem:=AnItem^.Next; - end; - if FCount<>RealCount then begin - Result:=-4; exit; - end; - Result:=0; -end; - -procedure TLazQueue.WriteDebugReport; -var AnItem: PLazQueueItem; -begin - writeln('TLazQueue.WriteDebugReport: Consistency=',ConsistencyCheck - ,' Count=',Count,' FreeCount=',FFreeCount); - AnItem:=FFirst; - while AnItem<>nil do begin - writeln(' Item: Data=',HexStr(Cardinal(AnItem^.Data),8) - ,' Self=',HexStr(Cardinal(AnItem),8) - ,' Next=',HexStr(Cardinal(AnItem^.Next),8) - ,' Prior=',HexStr(Cardinal(AnItem^.Prior),8) - ); - AnItem:=AnItem^.Next; - end; -end; - - -end. -