made gtklayout using window theme at start

git-svn-id: trunk@4861 -

lcl/interfaces/gtk/gtkobject.inc

@@ -7578,10 +7578,10 @@ procedure TGTKObject.SelectGDKPenProps(DC: HDC);
 
   procedure SetDashes(const Dashes: array of gint8);
   begin
-    BeginGDKErrorTrap;
+    {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
     laz_gdk_gc_set_dashes(TDeviceContext(DC).GC,0,Pgint8(@Dashes[Low(Dashes)]),
       High(Dashes)-Low(Dashes)+1);
-    EndGDKErrorTrap;
+    {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
   end;
 
 begin
@@ -7601,12 +7601,12 @@ begin
         IsNullPen := GDIPenStyle = PS_NULL;
         if (GDIPenStyle = PS_SOLID) or (GDIPenStyle = PS_INSIDEFRAME)
         then begin
-          BeginGDKErrorTrap;
+          {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
           gdk_gc_set_line_attributes(GC, GDIPenWidth, GDK_LINE_SOLID, GDK_CAP_NOT_LAST, GDK_JOIN_MITER);
-          EndGDKErrorTrap;
+          {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
         end
         else begin
-          BeginGDKErrorTrap;
+          {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
           gdk_gc_set_line_attributes(GC,GDIPenWidth,GDK_LINE_ON_OFF_DASH,GDK_CAP_NOT_LAST,GDK_JOIN_MITER);
           case GDIPenStyle of
             {$IfDef GTK2}
@@ -7623,7 +7623,7 @@ begin
             //This is DEADLY!!!
             //PS_NULL:       gdk_gc_set_dashes(GC, 0, [0,4], 2);
           end;
-          EndGDKErrorTrap;
+          {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
         end;
       end;
       Include(TDeviceContext(DC).DCFlags,dcfPenSelected);
@@ -8465,6 +8465,9 @@ end;
  { =============================================================================
 
   $Log$
+  Revision 1.439  2003/11/29 13:17:38  mattias
+  made gtklayout using window theme at start
+
   Revision 1.438  2003/11/28 11:25:49  mattias
   added BitOrder for RawImages
 

lcl/interfaces/gtk/gtkproc.inc

@@ -4470,8 +4470,8 @@ end;
 Function CreateFormContents(AForm: TCustomForm;
   var FormWidget: Pointer): Pointer;
 var
-  ScrolledWidget,
+  ScrolledWidget, ClientAreaWidget: PGtkWidget;
-  ClientAreaWidget: Pointer;
+  WindowStyle: PGtkStyle;
 begin
   // Create the VBox. We need that to place controls outside
   // the client area (like menu)
@@ -4479,20 +4479,15 @@ begin
   If FormWidget = nil then
     FormWidget := Result;
 
-  // Create the form client area
+  // Create the form client area (a scrolled window with a gtklayout
-  if {$IFDEF PolymorphClientArea}(AForm=nil) or AForm.HasVisibleScrollbars
+  // with the style of a window)
-     {$ELSE}true{$ENDIF}
-  then begin
   ScrolledWidget := gtk_scrolled_window_new(nil,nil);
   gtk_box_pack_end(Result, ScrolledWidget, True, True, 0);
   gtk_widget_show(ScrolledWidget);
   ClientAreaWidget := gtk_layout_new(nil, nil);
-    gtk_container_add(ScrolledWidget, ClientAreaWidget);
+  WindowStyle:=GetStyle('window');
-  end else begin
+  gtk_widget_set_style(ClientAreaWidget,WindowStyle);
-    ScrolledWidget:=nil;
+  gtk_container_add(PGtkContainer(ScrolledWidget), ClientAreaWidget);
-    ClientAreaWidget := gtk_fixed_new;
-    gtk_box_pack_end(Result, ClientAreaWidget, True, True, 0);
-  end;
 
   gtk_object_set_data(FormWidget,odnScrollArea,ScrolledWidget);
 
@@ -4671,6 +4666,14 @@ begin
     If (StyleObject^.Widget <> nil) then begin
       gtk_widget_ensure_style(StyleObject^.Widget);
       StyleObject^.Style:=GTK_RC_GET_STYLE(StyleObject^.Widget);
+      // ToDo: find out, why sometimes the style is not initialized.
+      // for example: why the following occurs:
+       If AnsiCompareText(WName,'button')=0 then begin
+        if StyleObject^.Style^.light_gc[GTK_STATE_NORMAL]=nil then begin
+          //if not GtkWidgetIsA(StyleObject^.Widget,GTK_WINDOW_TYPE) then begin
+          //end;
+        end;
+      end;
     end;
     If StyleObject^.Style <> nil then
       If AnsiCompareText(WName,'gtk_default')<>0 then
@@ -4679,7 +4682,8 @@ begin
     if StyleObject^.Style <> nil then begin
       Styles.AddObject(WName, TObject(StyleObject));
       Result:=StyleObject^.Style;
-      If StyleObject^.Widget <> nil then
+      If (StyleObject^.Widget <> nil)
+      and (AnsiCompareText(WName,'window')=0) then
         UpdateSysColorMap(StyleObject^.Widget);
     end
     else begin
@@ -4769,6 +4773,26 @@ begin
 end;
 {$EndIf}
 
+procedure RealizeGDKColor(ColorMap: PGdkColormap; Color: PGDKColor);
+var
+  AllocResult: gboolean;
+begin
+  if ColorMap=nil then ColorMap:=gdk_colormap_get_system;
+  if (Color^.pixel = 0)
+  and ((Color^.red<>0) or (Color^.blue<>0) or (Color^.green<>0)) then
+    gdk_colormap_alloc_colors(ColorMap, Color, 1, false, true, @AllocResult)
+  else
+    gdk_colormap_query_color(ColorMap,Color^.pixel, Color);
+end;
+
+procedure RealizeGtkStyleColor(Style: PGTKStyle; Color: PGDKColor);
+begin
+  if (Style<>nil) then
+    RealizeGDKColor(Style^.ColorMap,Color)
+  else
+    RealizeGDKColor(nil,Color);
+end;
+
 Function GetSysGCValues(Color: TColorRef;
   ThemeWidget: PGtkWidget): TGDKGCValues;
 // ThemeWidget can be nil
@@ -4793,7 +4817,6 @@ var
   SysColor: TColorRef;
   BaseColor: TColorRef;
   Red, Green, Blue: byte;
-  success: Boolean;
 begin
   BaseColor := Color and $FF;
 
@@ -5043,22 +5066,7 @@ begin
     ?????????????????}
   end;
 
-  if (result.foreground.pixel = 0) and ((result.foreground.red <> 0) or
+  RealizeGtkStyleColor(Style,@Result.foreground);
-     (result.foreground.blue <> 0) or (result.foreground.green <> 0)) then
-   begin
-     if (style <> nil) and (style^.colormap <> nil) then
-         gdk_colormap_alloc_colors(style^.colormap, @result.foreground, 1,
-           false, true, nil)
-       else
-         gdk_colormap_alloc_colors(gdk_colormap_get_system(),
-           @result.foreground, 1, false, true, @success);
-   end else
-     if (style <> nil) and (style^.colormap <> nil) then
-       gdk_colormap_query_color(style^.colormap,result.foreground.pixel,
-         @result.foreground)
-     else
-       gdk_colormap_query_color(gdk_colormap_get_system(),
-         result.foreground.pixel, @result.foreground);
 end;
 
 Function StyleForegroundColor(Color: TColorRef;
@@ -5139,10 +5147,7 @@ begin
     Result := DefaultColor;
 
   if (Result <> nil) and (Result <> DefaultColor) then
-    if  (style^.colormap <> nil) then
+    RealizeGtkStyleColor(Style,Result);
-      gdk_colormap_query_color(style^.colormap,result^.pixel, result)
-    else
-      gdk_colormap_query_color(gdk_colormap_get_system(),result^.pixel, result)
 end;
 
 Procedure StyleFillRectangle(drawable : PGDKDrawable; GC : PGDKGC; Color : TColorRef; x, y, width, height : gint);
@@ -5615,6 +5620,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.231  2003/11/29 13:17:38  mattias
+  made gtklayout using window theme at start
+
   Revision 1.230  2003/11/26 21:30:19  mattias
   reduced unit circles, fixed fpImage streaming
 

lcl/interfaces/gtk/gtkproc.pp

@@ -515,6 +515,8 @@ function LoadDefaultFontDesc: PPangoFontDescription;
 function LoadDefaultFont: PGDKFont;
 {$EndIf}
 
+procedure RealizeGDKColor(ColorMap: PGdkColormap; Color: PGDKColor);
+procedure RealizeGtkStyleColor(Style: PGTKStyle; Color: PGDKColor);
 Function GetSysGCValues(Color: TColorRef; ThemeWidget: PGtkWidget): TGDKGCValues;
 
 {$Ifdef GTK1}
@@ -532,7 +534,7 @@ Procedure FillScreenFonts(ScreenFonts : TStrings);
 function GetGDKMouseCursor(Cursor: TCursor): PGdkCursor;
 Procedure FreeGDKCursors;
 
-// functions for easier GTK2<->GTK1 Compatibility/Consistancy  ---->
+// functions for easier GTK2<->GTK1 Compatibility/Consistency  ---->
 function gtk_widget_get_xthickness(Style : PGTKStyle) : gint; overload;
 function gtk_widget_get_ythickness(Style : PGTKStyle) : gint; overload;
 

lcl/interfaces/gtk/gtkwinapi.inc

@@ -5758,10 +5758,10 @@ begin
         if (CurrentPen^.IsNullPen) then exit;
 
         DCOrigin:=GetDCOffset(TDeviceContext(DC));
-        BeginGDKErrorTrap;
+        {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
         gdk_draw_line(Drawable, GC, PenPos.X+DCOrigin.X, PenPos.Y+DCOrigin.Y,
                       X+DCOrigin.X, Y+DCOrigin.Y);
-        EndGDKErrorTrap;
+        {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
         PenPos:= Point(X, Y);
       end else
         Result := False;
@@ -9032,6 +9032,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.303  2003/11/29 13:17:38  mattias
+  made gtklayout using window theme at start
+
   Revision 1.302  2003/11/24 11:03:07  marc
   * Splitted winapi*.inc into a winapi and a lcl interface communication part
 

packager/packagesystem.pas

@@ -132,7 +132,8 @@ type
     function FindAutoInstallDependencyPath(ChildPackage: TLazPackage): TList;
     function FindAmbigiousUnits(APackage: TLazPackage;
                                 FirstDependency: TPkgDependency;
-                                var File1, File2: TPkgFile): boolean;
+                                var File1, File2: TPkgFile;
+                                var ConflictPkg: TLazPackage): boolean;
     function FindFileInAllPackages(const TheFilename: string;
                                 ResolveLinks, IgnoreDeleted: boolean): TPkgFile;
     function FindLowestPkgNodeByName(const PkgName: string): TAVLTreeNode;
@@ -1333,11 +1334,14 @@ begin
 end;
 
 function TLazPackageGraph.FindAmbigiousUnits(APackage: TLazPackage;
-  FirstDependency: TPkgDependency; var File1, File2: TPkgFile): boolean;
+  FirstDependency: TPkgDependency; var File1, File2: TPkgFile;
+  var ConflictPkg: TLazPackage): boolean;
 // check if two connected packages have units with the same name
 // Connected means here: a Package1 is directly required by a Package2
 // or: a Package1 and a Package2 are directly required by a Package3
 // returns true, if ambigious units found
+// There can either be a conflict between two files (File1,File2)
+// or between a file and a package (File1,ConflictPkg)
 var
   PackageTreeOfUnitTrees: TAVLTree; // tree of TPkgUnitsTree
   
@@ -1377,10 +1381,19 @@ var
     if Pkg1=Pkg2 then exit;
     if (Pkg1.FileCount=0) or (Pkg2.FileCount=0) then exit;
     UnitsTreeOfPkg2:=GetUnitsTreeOfPackage(Pkg2);
+    // check if a unit of Pkg2 has the same name as Pkg1
+    PkgFile2:=UnitsTreeOfPkg2.FindPkgFileWithUnitName(Pkg1.Name);
+    if PkgFile2<>nil then begin
+      File1:=PkgFile2;
+      ConflictPkg:=Pkg1;
+      Result:=true;
+      exit;
+    end;
     for i:=0 to Pkg1.FileCount-1 do begin
       PkgFile1:=Pkg1.Files[i];
       if (PkgFile1.FileType in PkgFileUnitTypes)
       and (PkgFile1.UnitName<>'') then begin
+        // check if a unit of Pkg1 exists in Pkg2
         PkgFile2:=UnitsTreeOfPkg2.FindPkgFileWithUnitName(PkgFile1.UnitName);
         if PkgFile2<>nil then begin
           File1:=PkgFile1;
@@ -1388,6 +1401,13 @@ var
           Result:=true;
           exit;
         end;
+        // check if a unit of Pkg1 has the same name as Pkg2
+        if AnsiCompareText(PkgFile1.UnitName,Pkg2.Name)=0 then begin
+          File1:=PkgFile1;
+          ConflictPkg:=Pkg2;
+          Result:=true;
+          exit;
+        end;
       end;
     end;
   end;
@@ -1404,6 +1424,7 @@ begin
   end;
   File1:=nil;
   File2:=nil;
+  ConflictPkg:=nil;
   ConnectionsTree:=nil;
   PkgList:=nil;
   PackageTreeOfUnitTrees:=nil;

packager/pkgmanager.pas

@@ -741,6 +741,8 @@ var
   PathList: TList;
   Dependency: TPkgDependency;
   PkgFile1,PkgFile2: TPkgFile;
+  ConflictPkg: TLazPackage;
+  s: String;
 begin
   {$IFDEF VerbosePkgCompile}
   writeln('TPkgManager.CheckPackageGraphForCompilation A');
@@ -792,14 +794,23 @@ begin
     end;
 
     // check for ambigious units
-    if PackageGraph.FindAmbigiousUnits(APackage,FirstDependency,PkgFile1,PkgFile2)
+    if PackageGraph.FindAmbigiousUnits(APackage,FirstDependency,
+      PkgFile1,PkgFile2,ConflictPkg)
     then begin
-      Result:=MessageDlg('Ambigious units found',
+      if PkgFile2<>nil then begin
-        'There are two units with the same name:'#13
+        s:='There are two units with the same name:'#13
           +#13
           +'1. "'+PkgFile1.Filename+'" from '+PkgFile1.LazPackage.IDAsString+#13
           +'2. "'+PkgFile2.Filename+'" from '+PkgFile2.LazPackage.IDAsString+#13
+          +#13;
+      end else begin
+        s:='There is a unit with the same name as a package:'#13
           +#13
+          +'1. "'+PkgFile1.Filename+'" from '+PkgFile1.LazPackage.IDAsString+#13
+          +'2. "'+ConflictPkg.IDAsString+#13
+          +#13;
+      end;
+      Result:=MessageDlg('Ambigious units found',s
           +'Both packages are connected. This means, either one package uses '
           +'the other, or they are both used by a third package.',
           mtError,[mbCancel,mbAbort],0);