fixed TShape FPCanvas issue

git-svn-id: trunk@6885 -

lcl/include/shape.inc

@@ -43,7 +43,7 @@ begin
     Pen := FPen;
     Brush := FBrush;
 
-    PaintRect := Rect(0,0,Width - 1, Height - 1);
+    PaintRect := Rect(0,0,Self.Width - 1, Self.Height - 1);
     InflateRect(PaintRect, -(Pen.Width div 2), -(Pen.Width div 2));
     With PaintRect do begin
       MinSize := Min(Right - Left, Bottom - Top);
@@ -106,6 +106,9 @@ end;
 { =============================================================================
 
  $Log$
+ Revision 1.5  2005/03/04 12:21:55  mattias
+ fixed TShape FPCanvas issue
+
  Revision 1.4  2004/04/10 17:58:57  mattias
  implemented mainunit hints for include files
 

lcl/interfaces/gtk/gtkcallback.inc

@@ -2747,9 +2747,9 @@ begin
   end;
   {$IFDEF DEBUG_CLIPBOARD}
   DebugLn('[ClipboardSelectionReceivedHandler] A TimeID=',dbgs(TimeID),' RequestIndex=',dbgs(i),
-    ' selection=',dbgs(SelectionData^.selection),
+    ' selection=',dbgs(SelectionData^.selection)+'='+gdk_atom_name(SelectionData^.selection),
-    ' target=',dbgs(SelectionData^.Target),
+    ' target=',dbgs(SelectionData^.Target)+'='+gdk_atom_name(SelectionData^.Target),
-    ' theType=',dbgs(SelectionData^.theType),
+    ' theType=',dbgs(SelectionData^.theType)+'='+gdk_atom_name(SelectionData^.theType),
     ' format=',dbgs(SelectionData^.format),
     ' len=',dbgs(SelectionData^.length)
     );
@@ -2772,8 +2772,23 @@ begin
     {$IFDEF DEBUG_CLIPBOARD}
     DebugLn('[ClipboardSelectionReceivedHandler] C FirstCharacter=',dbgs(ord(PChar(c^.Data.Data)[0])));
     {$ENDIF}
-  end else
+  end else begin
+    {if (SelectionData^.Target <> GDK_TARGET_STRING)
+    and (SelectionData^.length<0) then begin
+      if gtk_selection_convert (TargetWidget, SelectionData^.selection,
+        GDK_TARGET_STRING, TimeID)<>GdkFalse
+      then begin
+        DebugLn('[ClipboardSelectionReceivedHandler] D TimeID=',dbgs(TimeID),' RequestIndex=',dbgs(i),
+          ' selection=',dbgs(SelectionData^.selection)+'='+gdk_atom_name(SelectionData^.selection),
+          ' target=',dbgs(SelectionData^.Target)+'='+gdk_atom_name(SelectionData^.Target),
+          ' theType=',dbgs(SelectionData^.theType)+'='+gdk_atom_name(SelectionData^.theType),
+          ' format=',dbgs(SelectionData^.format),
+          ' len=',dbgs(SelectionData^.length)
+          );
+      end;
+    end;}
     c^.Data.Data:=nil;
+  end;
 end;
 
 {------------------------------------------------------------------------------
@@ -2791,8 +2806,8 @@ var ClipboardType: TClipboardType;
   FormatID: cardinal;
   Buffer: Pointer;
   BufLength: integer;
-  P: PChar;
   BitCount: integer;
+  P: PChar;
 begin
   {$IFDEF DEBUG_CLIPBOARD}
   DebugLn('*** [ClipboardSelectionRequestHandler] START');
@@ -2805,9 +2820,7 @@ begin
         // handler found for this of clipboard
         // now create a stream and find a supported format
         {$IFDEF DEBUG_CLIPBOARD}
-        p:=gdk_atom_name(SelectionData^.Target);
+        DebugLn('[ClipboardSelectionRequestHandler] "',ClipboardTypeName[ClipboardType],'" Format=',GdkAtomToStr(SelectionData^.Target),' ID=',dbgs(SelectionData^.Target));
-        DebugLn('[ClipboardSelectionRequestHandler] ',ClipboardTypeName[ClipboardType],' Format=',dbgs(p),' ID=',dbgs(SelectionData^.Target));
-        g_free(p);
         {$ENDIF}
         MemStream:=TMemoryStream.Create;
         try
@@ -2824,7 +2837,7 @@ begin
             FormatID:=gdk_atom_intern('text/plain',GdkFalse);
 
           {$IFDEF DEBUG_CLIPBOARD}
-          DebugLn('[ClipboardSelectionRequestHandler] FormatID=',dbgs(FormatID),' CompoundText=',dbgs(gdk_atom_intern('COMPOUND_TEXT',1)),' ',dbgs(ClipboardExtraGtkFormats[ClipboardType][gfCOMPOUND_TEXT]));
+          DebugLn('[ClipboardSelectionRequestHandler] FormatID=',dbgs(FormatID),'=',GdkAtomToStr(FormatID),' ',dbgs(ClipboardExtraGtkFormats[ClipboardType][gfCOMPOUND_TEXT]));
           {$ENDIF}
           // get the requested data by calling the handler for this clipboard type
           ClipboardHandler[ClipboardType](FormatID,MemStream);
@@ -2962,6 +2975,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.272  2005/03/04 12:21:55  mattias
+  fixed TShape FPCanvas issue
+
   Revision 1.271  2005/03/02 16:47:20  mattias
   fixed loading forms under fpc 1.9.9
 

lcl/interfaces/gtk/gtkdef.pp

@@ -249,7 +249,7 @@ type
   TGtkClipboardFormat = (
     gfCLASS, gfCOMPOUND_TEXT, gfDELETE, gfFILE_NAME, gfHOST_NAME, gfLENGTH,
     gfMULTIPLE, gfNAME, gfOWNER_OS, gfPROCESS, gfSTRING, gfTARGETS, gfTEXT,
-    gfTIMESTAMP, gfUSER);
+    gfTIMESTAMP, gfUSER, gfUTF8_STRING);
     
   TGtkClipboardFormats = set of TGtkClipboardFormat;
 
@@ -257,7 +257,7 @@ const
   GtkClipboardFormatName: array[TGtkClipboardFormat] of string = (
       'CLASS', 'COMPOUND_TEXT', 'DELETE', 'FILE_NAME', 'HOST_NAME', 'LENGTH',
       'MULTIPLE', 'NAME', 'OWNER_OS', 'PROCESS', 'STRING', 'TARGETS', 'TEXT',
-      'TIMESTAMP', 'USER'
+      'TIMESTAMP', 'USER', 'UTF8_STRING'
     );
   
 const
@@ -582,6 +582,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.65  2005/03/04 12:21:55  mattias
+  fixed TShape FPCanvas issue
+
   Revision 1.64  2005/02/18 09:44:30  vincents
   added constants for gtk1 version, fixes fpc 1.0.x compilation
 

lcl/interfaces/gtk/gtkobject.inc

@@ -6630,7 +6630,7 @@ const
         TmpList:=TargetList^.List;
         while TmpList<>nil do begin
           Pair:=PGtkTargetPair(TmpList^.Data);
-          DebugLn('    WriteTargetLists BBB ',dbgs(Pair^.Target));
+          DebugLn('    WriteTargetLists BBB ',dbgs(Pair^.Target),' ',GdkAtomToStr(Pair^.Target));
           TmpList:=TmpList^.Next;
         end;
       end;
@@ -6697,6 +6697,9 @@ begin
                   ClipboardTargetEntries[c],ClipboardTargetEntryCnt[c]);
       end;
     end;
+    {$IFDEF DEBUG_CLIPBOARD}
+    WriteTargetLists(ClipboardWidget);
+    {$ENDIF}
   end;
 end;
 
@@ -6995,6 +6998,9 @@ end;
  { =============================================================================
 
   $Log$
+  Revision 1.635  2005/03/04 12:21:55  mattias
+  fixed TShape FPCanvas issue
+
   Revision 1.634  2005/03/02 16:47:20  mattias
   fixed loading forms under fpc 1.9.9
 

lcl/interfaces/gtk/gtkproc.inc

@@ -6256,7 +6256,7 @@ begin
   repeat
     repeat
       inc(TimeID);
-      if TimeID>1100 then exit;
+      if TimeID>1010 then exit;
       i:=ClipboardSelectionData.Count-1;
       while (i>=0) 
       and (PClipboardEventData(ClipboardSelectionData[i])^.TimeID<>TimeID) do
@@ -6267,7 +6267,7 @@ begin
     FillChar(c^.Data,SizeOf(TGtkSelectionData),0);
     ClipboardSelectionData.Add(c);
     {$IFDEF DEBUG_CLIPBOARD}
-    DebugLn('[RequestSelectionData] TimeID=',dbgs(TimeID));
+    DebugLn('[RequestSelectionData] TimeID=',dbgs(TimeID),' ',GdkAtomToStr(ClipboardTypeAtoms[ClipboardType]),' FormatID=',GdkAtomToStr(FormatID));
     {$ENDIF}
     if gtk_selection_convert(ClipboardWidget, ClipboardTypeAtoms[ClipboardType],
                              FormatID, TimeID)<>GdkFalse
@@ -6302,6 +6302,20 @@ begin
   end;
 end;
 
+{------------------------------------------------------------------------------
+  function GdkAtomToStr(const Atom: TGdkAtom): string;
+  
+  Returns the associated string
+ ------------------------------------------------------------------------------}
+function GdkAtomToStr(const Atom: TGdkAtom): string;
+var
+  p: Pgchar;
+begin
+  p:=gdk_atom_name(Atom);
+  Result:=p;
+  g_free(p);
+end;
+
 {-------------------------------------------------------------------------------
   Function CreateFormContents(AForm: TCustomForm;
     var FormWidget: Pointer): Pointer;
@@ -8083,6 +8097,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.347  2005/03/04 12:21:56  mattias
+  fixed TShape FPCanvas issue
+
   Revision 1.346  2005/03/02 16:47:20  mattias
   fixed loading forms under fpc 1.9.9
 

lcl/interfaces/gtk/gtkproc.pp

@@ -685,6 +685,7 @@ function WaitForClipboardAnswer(c: PClipboardEventData): boolean;
 function RequestSelectionData(ClipboardWidget: PGtkWidget;
   ClipboardType: TClipboardType;  FormatID: cardinal): TGtkSelectionData;
 procedure FreeClipboardTargetEntries(ClipboardType: TClipboardType);
+function GdkAtomToStr(const Atom: TGdkAtom): string;
 
 // forms
 Function CreateFormContents(AForm: TCustomForm; var FormWidget: Pointer): Pointer;

lcl/interfaces/gtk/gtkwinapi.inc

@@ -350,10 +350,10 @@ var FormatAtom, FormatTry: Cardinal;
       SelData:=RequestSelectionData(ClipboardWidget,ClipboardType,AllID);
       {DebugLn('IsFormatSupported A ',HexStr(Cardinal(SelData.Selection),8),
       ' ',HexStr(Cardinal(ClipboardTypeAtoms[ClipboardType]),8),
-      ' SelData.Target=',SelData.Target,' AllID=',AllID,
+      ' SelData.Target='+dbgs(SelData.Target),' AllID='+dbgs(AllID),
-      ' SelData.TheType=',SelData.TheType,' ',gdk_atom_intern('ATOM',0),
+      ' SelData.TheType='+dbgs(SelData.TheType),' '+dbgs(gdk_atom_intern('ATOM',0)),
-      ' SelData.Length=',SelData.Length,
+      ' SelData.Length='+dbgs(SelData.Length),
-      ' SelData.Format=',SelData.Format
+      ' SelData.Format='+dbgs(SelData.Format)
       );}
       if (SelData.Selection<>ClipboardTypeAtoms[ClipboardType])
       or (SelData.Target<>AllID)
@@ -363,6 +363,12 @@ var FormatAtom, FormatTry: Cardinal;
       end;
       SupportedCnt:=SelData.Length div (SelData.Format shr 3);
       SupportedFormats:=PGdkAtom(SelData.Data);
+      
+      {a:=SupportedCnt-1;
+      while (a>=0) do begin
+        debugln(' ',dbgs(a),' ',GdkAtomToStr(SupportedFormats[a]),' "',p,'"');
+        dec(a);
+      end;}
     end;
     a:=SupportedCnt-1;
     while (a>=0) and (SupportedFormats[a]<>Format) do dec(a);
@@ -371,7 +377,7 @@ var FormatAtom, FormatTry: Cardinal;
 
 begin
   {$IfDef DEBUG_CLIPBOARD}
-  DebugLn('[TGtkWidgetSet.ClipboardGetData] A ClipboardWidget=',HexStr(Cardinal(ClipboardWidget),8),' Format=',ClipboardFormatToMimeType(FormatID),' Now=',dbgs(Now));
+  DebugLn('[TGtkWidgetSet.ClipboardGetData] A ClipboardWidget=',HexStr(Cardinal(ClipboardWidget),8),' FormatID=',ClipboardFormatToMimeType(FormatID),' Now=',dbgs(Now));
   {$EndIf}
   Result:=false;
   if (FormatID=0) or (Stream=nil) then exit;
@@ -380,25 +386,30 @@ begin
   // request the data from the selection owner
   SupportedCnt:=-1;
   SupportedFormats:=nil;
+  FillChar(SelData,SizeOf(TGtkSelectionData),0);
   try
 
     FormatAtom:=FormatID;
     if (FormatAtom=gdk_atom_intern('text/plain',GdkTrue)) then begin
-      // text/plain is supported in various formats in gtk
-      // The COMPOUND_TEXT format supports internationalization and is therefore
-      // preferred even before 'text/plain'
       FormatAtom:=0;
-      FormatTry:=gdk_atom_intern('COMPOUND_TEXT',GdkTrue);
+      // text/plain is supported in various formats in gtk
+      FormatTry:=gdk_atom_intern('COMPOUND_TEXT',GdkFalse);
       if IsFormatSupported(FormatTry) then
         FormatAtom:=FormatTry;
+      // The COMPOUND_TEXT format can be converted and is therefore
+      // used as default for 'text/plain'
       if (SupportedCnt=0) then
-        FormatAtom:=gdk_atom_intern('COMPOUND_TEXT',GdkTrue);
+        FormatAtom:=gdk_atom_intern('COMPOUND_TEXT',GdkFalse);
+      // then check for UTF8 text format 'UTF8_STRING'
+      FormatTry:=gdk_atom_intern('UTF8_STRING',GdkFalse);
+      if IsFormatSupported(FormatTry) then
+        FormatAtom:=FormatTry;
       // then check for simple text format 'text/plain'
-      FormatTry:=gdk_atom_intern('text/plain',GdkTrue);
+      FormatTry:=gdk_atom_intern('text/plain',GdkFalse);
       if (FormatAtom=0) and IsFormatSupported(FormatTry) then
         FormatAtom:=FormatTry;
       // then check for simple text format STRING
-      FormatTry:=gdk_atom_intern('STRING',GdkTrue);
+      FormatTry:=gdk_atom_intern('STRING',GdkFalse);
       if (FormatAtom=0) and IsFormatSupported(FormatTry) then
         FormatAtom:=FormatTry;
       // check for some other formats that can be interpreted as text
@@ -412,25 +423,29 @@ begin
       if (FormatAtom=0) and IsFormatSupported(FormatTry) then
         FormatAtom:=FormatTry;
       // the TEXT format is not reliable, but it should be supported
-      FormatTry:=gdk_atom_intern('TEXT',GdkTrue);
+      FormatTry:=gdk_atom_intern('TEXT',GdkFalse);
       if (FormatAtom=0) and IsFormatSupported(FormatTry) then
         FormatAtom:=FormatTry;
     end;
 
     {$IfDef DEBUG_CLIPBOARD}
-    DebugLn('[TGtkWidgetSet.ClipboardGetData] B  Format=',ClipboardFormatToMimeType(FormatAtom),' Now=',dbgs(Now));
+    DebugLn('[TGtkWidgetSet.ClipboardGetData] B  Format=',ClipboardFormatToMimeType(FormatAtom),' FormatAtom=',dbgs(FormatAtom),' Now=',dbgs(Now));
     {$EndIf}
     if FormatAtom=0 then exit;
 
     // request data from owner
     SelData:=RequestSelectionData(ClipboardWidget,ClipboardType,FormatAtom);
-    try
     {$IfDef DEBUG_CLIPBOARD}
-      DebugLn('[TGtkWidgetSet.ClipboardGetData] C  Length=',dbgs(SelData.Length),' Now=',dbgs(Now));
+    DebugLn('[TGtkWidgetSet.ClipboardGetData] C  Length=',dbgs(SelData.Length),' Now=',dbgs(Now),' ',
+      ' SelData.Selection=',dbgs(SelData.Selection),' SelData.Length=',dbgs(SelData.Length));
     {$EndIf}
     if (SelData.Selection<>ClipboardTypeAtoms[ClipboardType])
-      or (SelData.Target<>FormatAtom) then
+    or (SelData.Target<>FormatAtom) then begin
+      {$IfDef DEBUG_CLIPBOARD}
+      DebugLn('[TGtkWidgetSet.ClipboardGetData] REQUESTED FORMAT NOT SUPPORTED  Length=',dbgs(SelData.Length));
+      {$ENDIF}
       exit;
+    end;
 
     // write data to stream
     if (SelData.Data<>nil) and (SelData.Length>0) then begin
@@ -457,12 +472,10 @@ begin
     {$IfDef DEBUG_CLIPBOARD}
     DebugLn('[TGtkWidgetSet.ClipboardGetData] END ',' Now=',dbgs(Now));
     {$EndIf}
-    finally
-      if SelData.Data<>nil then FreeMem(SelData.Data);
-    end;
     Result:=true;
   finally
     if SupportedFormats<>nil then FreeMem(SupportedFormats);
+    if SelData.Data<>nil then FreeMem(SelData.Data);
   end;
 end;
 
@@ -8924,6 +8937,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.403  2005/03/04 12:21:56  mattias
+  fixed TShape FPCanvas issue
+
   Revision 1.402  2005/03/02 16:47:20  mattias
   fixed loading forms under fpc 1.9.9