[lazarus] gtk interface clean up

[Jeroen van Iddekinge]

Hi,

>Where is gtkmsgqueue.pp?
>Can you delete the *~ files in the base directory before creating the patch?
>
Ok Sorry, GtkMsgQueue as attachment.

Jer





 {*************************************************************************** 
                     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.                     *
 *                                                                           *
 *****************************************************************************
 }

{$mode objfpc}

unit gtkmsgqueue;
interface
uses lazqueue,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);
		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);
		function   FindPaintMessage(HandleWnd: HWnd): TGtkMessageQueueItem;
		function   HasPaintMessages:boolean;
		function   HasNonPaintMessages:boolean;
		function   NumberOfPaintMessages:integer;
		procedure  PopFirstMessage(var ParMsg : TMsg);
	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);
begin
	if (ParFinalInternalOnly = FPMF_All) or ((ParFinalInternalOnly = FPMF_Internal) and (fMsg^.message = LM_GtkPaint)) then FinalizePaintTagMsg(fMsg);	
	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);
begin

	if (ParItem.IsPaintMessage) then begin
		fPaintMessages.Remove(ParItem);
		ParItem.DestroyMessage(ParFinalOnlyInternal);
	end;
	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;

procedure TGtkMessageQueue.PopFirstMessage(var ParMsg : TMsg);
var
	vlItem : TGtkMessageQueueItem;
begin
	vlItem := FirstMessageItem;
	ParMsg := vlItem.Msg^;
	RemoveMessage(vlItem,FPMF_none);	
end;

end.