renamed lazqueue to lazlinkedlist, patch from Jeroen

git-svn-id: trunk@4495 -

.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

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
 

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
 

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}
 

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
+    FMessageQueue: TGtkMessageQueue;      // queue of PMsg
-    FPaintMessages: TDynHashArray; // hasharray of PLazQueueItem
     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
 

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.
+
+

lcl/interfaces/gtk/gtkobject.inc

@@ -145,9 +145,7 @@ begin
   FDefaultFont:= nil;
 
   // messages
-  FMessageQueue := TLazQueue.Create;
+  FMessageQueue := TGtkMessageQueue.Create;
-  FPaintMessages := TDynHashArray.Create(-1);
-  FPaintMessages.OwnerHashFunction := @HashPaintMessage;
   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
+  // tidy up the paint messages
-  QueueItem:=FMessageQueue.First;
+  QueueItem:=FMessageQueue.FirstMessageItem;
   while (QueueItem<>nil) do begin
-    p := PMsg(QueueItem^.Data);
+    NextQueueItem := TGtkMessageQueueItem(QueueItem.Next);
-    if (p^.Message=LM_PAINT) or (p^.Message=LM_GtkPAINT) then begin
+    if QueueItem.IsPaintMessage then
-      //writeln('[TgtkObject.Destroy]  freeing unused paint message ',HexStr(p^.WParam,8));
+      fMessageQueue.RemoveMessage(QueueItem,FPMF_All,true);
-      FPaintMessages.Remove(QueueItem);
+    QueueItem := NextQueueItem;
-      FinalizePaintTagMsg(p);
-      Dispose(P);
-      OldQueueItem:=QueueItem;
-      QueueItem:=QueueItem^.Next;
-      FMessageQueue.Delete(OldQueueItem);
-    end else
-      QueueItem:=QueueItem^.Next;
   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
+  // tidy up messages
-    WriteLN(ProcName, Format(rsWarningUnreleasedMessagesInQueue,[
+  if FMessageQueue.Count > 0   then begin
-      FMessageQueue.Count]));
+    WriteLN(ProcName, Format(rsWarningUnreleasedMessagesInQueue,[FMessageQueue.Count]));
-    while FMessageQueue.First<>nil do begin
+    while FMessageQueue.First<>nil do
-      p := PMsg(FMessageQueue.First^.Data);
+      fMessageQueue.RemoveMessage(fMessageQueue.FirstMessageItem,FPMF_All,true);
-      Dispose(P);
-      FMessageQueue.Delete(FMessageQueue.First);
-    end;
   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;
+  vlItem : TGtkMessageQueueItem;
-  IsPaintMessage: boolean;
+  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 true do  begin
-      while First<>nil do
+      // fetch first message
-      begin
+      vlItem := fMessageQueue.FirstMessageItem;
-        // fetch first message
+      if vlItem = nil then break;
-        p := PMsg(First^.Data);
-        Msg := p^;
-        IsPaintMessage:=(Msg.Message=LM_PAINT) or (Msg.Message=LM_GtkPaint);
 
-        // remove message from queue
+      // remove message from queue
-        if IsPaintMessage then begin
+      if vlItem.IsPaintMessage then begin
-          // paint messages are the most expensive messages in the LCL,
+        // paint messages are the most expensive messages in the LCL,
-          // therefore they are sent always after all other
+        // therefore they are sent always after all other
-          if Count>FPaintMessages.Count then begin
+        if fMessageQueue.HasNonPaintMessages then begin
-            // there are non paint messages -> keep paint message back
+          // there are non paint messages -> keep paint message back
-            MoveToLast(First);
+          fMessageQueue.MoveToLast(FMessageQueue.First);
-            continue;
+          continue;
-          end else begin
+        end else begin
-            // there are only paint messages left in the queue
+          // there are only paint messages left in the queue
-            // -> check other queues
+          // -> check other queues
-            if PendingGtkMessagesExists then break;
+          if PendingGtkMessagesExists then break;
-          end;
-          FPaintMessages.Remove(First);
         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);
+    MsgPtr := QueueItem.Msg;
-    if (MsgPtr^.hWnd=Handle) then begin
+    NextItem := TGtkMessagequeueItem(QueueItem.Next);
-      // remove message
+    if (MsgPtr^.hWnd=Handle) then
-      if (MsgPtr^.Message=LM_PAINT) or (MsgPtr^.Message=LM_GtkPAINT) then begin
+      fMessageQueue.RemoveMessage(QueueItem,FPMF_All,true);
-        FPaintMessages.Remove(QueueItem);
+    QueueItem := NextItem;
-        FinalizePaintTagMsg(MsgPtr);
-      end;
-      Dispose(MsgPtr);
-      OldQueueItem:=QueueItem;
-      QueueItem:=QueueItem^.Next;
-      FMessageQueue.Delete(OldQueueItem);
-    end else begin
-      QueueItem:=QueueItem^.Next;
-    end;
   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
 

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,
+  LCLStrConsts, LCLLinux, LCLType, gtkDef, DynHashArray, LazLinkedList,
-  GraphMath, Graphics, Buttons, Menus, GTKWinApiWindow, StdCtrls, ComCtrls,
+  GraphType, GraphMath, Graphics, Buttons, Menus, GTKWinApiWindow, StdCtrls,
-  CListBox, KeyMap, Calendar, Arrow, Spin, CommCtrl, ExtCtrls, Dialogs,
+  ComCtrls, CListBox, KeyMap, Calendar, Arrow, Spin, CommCtrl, ExtCtrls,
-  FileCtrl, LResources, Math, GTKGlobals;
+  Dialogs, FileCtrl, LResources, Math, GTKGlobals;
 
 
   {$IFDEF gtk2}

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
-  
+  writeln('Peek !!!' );
-  Result := FMessageQueue.Count > 0;
+  vlItem := fMessageQueue.FirstMessageItem;
-  if Result 
+  Result := vlItem <> nil;
-  then begin
+
-    AMessage := FMessageQueue.First^.Data;
+  if Result  then begin
-    lpMsg := AMessage^;
+    lpMsg := vlItem.Msg^;
-    if (wRemoveMsg and PM_REMOVE) = PM_REMOVE 
+    if (wRemoveMsg and PM_REMOVE) = PM_REMOVE then
-    then begin
+      fMessageQueue.RemoveMessage(vlItem,FPMF_Internal,true);
-      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;
   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;
+  procedure CombinePaintMessages(NewMsg: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);
   // 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);
+    fMessageQueue.RemoveMessage(vlItem,FPMF_All,true);
-    Dispose(OldMsg);
   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);
+    CombinePaintMessages(AMessage);
-    FPaintMessages.Add(FMessageQueue.Last);
+  end ;
-  end else begin
+
-    FMessageQueue.AddLast(AMessage);
+  FMessageQueue.AddMessage(AMessage);
-  end;
 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
 

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.
+

lcl/lazqueue.pp

@@ -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.
-