various fixes for carbon

git-svn-id: trunk@8428 -

Makefile

@@ -1,8 +1,8 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/09/23]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/11/15]
 #
 default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince powerpc64-linux
 BSDs = freebsd netbsd openbsd darwin
 UNIXs = linux $(BSDs) solaris qnx
 LIMIT83fs = go32v2 os2 emx watcom
@@ -345,6 +345,9 @@ endif
 ifeq ($(FULL_TARGET),arm-wince)
 override TARGET_DIRS+=lcl components packager/registration ideintf designer packager
 endif
+ifeq ($(FULL_TARGET),powerpc64-linux)
+override TARGET_UNITS+=runtimetypeinfocontrols.pas
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_PROGRAMS+=lazarus startlazarus
 endif
@@ -453,6 +456,9 @@ endif
 ifeq ($(FULL_TARGET),arm-wince)
 override TARGET_PROGRAMS+=lazarus startlazarus
 endif
+ifeq ($(FULL_TARGET),powerpc64-linux)
+override CLEAN_FILES+=$(wildcard $(COMPILER_UNITTARGETDIR)/*$(OEXT)) $(wildcard $(COMPILER_UNITTARGETDIR)/*$(PPUEXT)) $(wildcard $(COMPILER_UNITTARGETDIR)/*$(RSTEXT)) $(wildcard *$(OEXT)) $(wildcard *$(PPUEXT)) $(wildcard *$(RSTEXT))
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_EXAMPLEDIRS+=examples
 endif
@@ -561,6 +567,9 @@ endif
 ifeq ($(FULL_TARGET),arm-wince)
 override TARGET_EXAMPLEDIRS+=examples
 endif
+ifeq ($(FULL_TARGET),powerpc64-linux)
+override COMPILER_OPTIONS+=-gl
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override CLEAN_FILES+=$(wildcard *$(OEXT)) $(wildcard *$(PPUEXT)) $(wildcard *$(RSTEXT))
 endif
@@ -3344,6 +3353,9 @@ packager:
 	$(MAKE) -C packager all
 .PHONY: packager_all packager_debug packager_smart packager_release packager_units packager_examples packager_shared packager_install packager_sourceinstall packager_exampleinstall packager_distinstall packager_zipinstall packager_zipsourceinstall packager_zipexampleinstall packager_zipdistinstall packager_clean packager_distclean packager_cleanall packager_info packager_makefiles packager
 endif
+ifeq ($(FULL_TARGET),powerpc64-linux)
+override COMPILER_UNITDIR+=../../ideintf/units/$(CPU_TARGET)-$(OS_TARGET)/ ../../lcl/units/$(CPU_TARGET)-$(OS_TARGET)/ ../../lcl/units/$(CPU_TARGET)-$(OS_TARGET)/$(LCL_PLATFORM)/ ../../packager/units/$(CPU_TARGET)-$(OS_TARGET)/ ./
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 TARGET_EXAMPLEDIRS_EXAMPLES=1
 endif

components/opengl/glcarbonaglcontext.pas

@@ -20,8 +20,9 @@ unit GLCarbonAGLContext;
 interface
 
 uses
-  Classes, SysUtils, LCLProc, LCLType, gl,
+  Classes, SysUtils, LCLProc, LCLType, gl, Forms,
-  FPCMacOSAll, InterfaceBase, CarbonInt,
+  FPCMacOSAll, CarbonInt, AGL, CarbonProc, CarbonDef, CarbonPrivate,
+  CarbonUtils,
   Controls;
   
 procedure LOpenGLViewport(Left, Top, Width, Height: integer);
@@ -31,38 +32,137 @@ function LOpenGLCreateContext(AWinControl: TWinControl;
                           SharedControl: TWinControl; AttrList: PInteger): HWND;
 
 const
-  DefaultOpenGLContextInitAttrList: array [0..10] of LongInt = (
+  DefaultOpenGLContextInitAttrList: array [0..5] of LongInt = (
-    GDK_GL_RGBA,
+    AGL_WINDOW,
-    GDK_GL_RED_SIZE, 1,
+    AGL_RGBA,
-    GDK_GL_GREEN_SIZE, 1,
+    AGL_NO_RECOVERY,
-    GDK_GL_BLUE_SIZE, 1,
+    AGL_DOUBLEBUFFER,
-    GDK_GL_DEPTH_SIZE, 1,
+    AGL_SINGLE_RENDERER,
-    GDK_GL_DOUBLEBUFFER,
+    AGL_NONE
-    GDK_GL_None
     );
+    
+type
+  TAGLControlInfo = record
+    Control: ControlRef;
+    AGLContext: TAGLContext;
+  end;
+  PAGLControlInfo = ^TAGLControlInfo;
 
+var
+  AGLControlInfo_FOURCC: FourCharCode;
+
+function CreateAGLControlInfo(Control: ControlRef; AGLContext: TAGLContext
+  ): PAGLControlInfo;
+function GetAGLControlInfo(Control: ControlRef): PAGLControlInfo;
+procedure FreeAGLControlInfo(Control: ControlRef);
+function GetAGLContext(Control: ControlRef): TAGLContext;
 
 implementation
 
 procedure LOpenGLViewport(Left, Top, Width, Height: integer);
 begin
-
+  glViewport(Left,Top,Width,Height);
 end;
 
 procedure LOpenGLSwapBuffers(Handle: HWND);
+var
+  AGLContext: TAGLContext;
 begin
-
+  AGLContext:=GetAGLContext(ControlRef(Handle));
+  aglSwapBuffers(AGLContext);
 end;
 
 function LOpenGLMakeCurrent(Handle: HWND): boolean;
+var
+  AGLContext: TAGLContext;
 begin
-
+  AGLContext:=GetAGLContext(ControlRef(Handle));
+  Result:=aglSetCurrentContext(aglContext)<>0;
 end;
 
 function LOpenGLCreateContext(AWinControl: TWinControl;
   SharedControl: TWinControl; AttrList: PInteger): HWND;
+var
+  disp: GDHandle;
+  aglPixFmt: TAGLPixelFormat;
+  aglContext: TAGLContext;
+  ACarbonWindow: WindowRef;
+  CFString: CFStringRef;
+  Control: ControlRef;
+  R: FPCMacOSAll.Rect;
+  Info: PWidgetInfo;
+  WSPrivate: TClass;
+  ParentWindow: WindowPtr;
 begin
+  if AWinControl.Parent=nil then
+    RaiseGDBException('GLCarbonAGLContext.LOpenGLCreateContext no parent');
+  ParentWindow:=WindowRef(AWinControl.Parent.Handle);
 
+  // create a dummy control
+  R:=GetCarbonRect(AWinControl.BoundsRect);
+  Control:=nil;
+  CFString := CFStringCreateWithCString(nil, Pointer(PChar('SubControl')),
+                                        kCFStringEncodingUTF8);
+  if CreatePushButtonControl(ParentWindow, R, CFString, Control) <> noErr
+  then
+    debugln('CreatePushButtonControl failed');
+  CFRelease(Pointer(CFString));
+
+  // create LCL WidgetInfo
+  Result:=HWnd(Control);
+  Info := CreateWidgetInfo(Control, AWinControl);
+  WSPrivate:=nil;
+  TCarbonPrivateHandleClass(WSPrivate).RegisterEvents(Info);
+
+  // create the AGL context
+  disp := GetMainDevice ();
+  aglPixFmt := aglChoosePixelFormat (@disp, 1, AttrList);
+  aglContext := aglCreateContext (aglPixFmt, NIL);
+  aglDestroyPixelFormat(aglPixFmt);
+
+  // use the carbon window.
+  // TODO: find a way to use only the control for the context
+  ACarbonWindow:=WindowRef(GetParentForm(AWinControl).Handle);
+  aglSetDrawable(aglContext,GetWindowPort(ACarbonWindow));
+
+  AGLControlInfo_FOURCC := MakeFourCC('ACI ');
+
+  CreateAGLControlInfo(Control,AGLContext);
+end;
+
+function CreateAGLControlInfo(Control: ControlRef; AGLContext: TAGLContext
+  ): PAGLControlInfo;
+begin
+  New(Result);
+  FillChar(Result^, SizeOf(Result^), 0);
+  Result^.Control:=Control;
+  Result^.AGLContext:=AGLContext;
+
+  SetControlProperty(Control, LAZARUS_FOURCC, AGLControlInfo_FOURCC,
+                     SizeOf(Result), @Result);
+end;
+
+function GetAGLControlInfo(Control: ControlRef): PAGLControlInfo;
+var
+  m: LongWord;
+begin
+  GetControlProperty(Control, LAZARUS_FOURCC, AGLControlInfo_FOURCC,
+                     SizeOf(Result), @m, @Result);
+end;
+
+procedure FreeAGLControlInfo(Control: ControlRef);
+var
+  Info: PAGLControlInfo;
+begin
+  Info:=GetAGLControlInfo(Control);
+  if Info=nil then exit;
+  RemoveControlProperty(Control, LAZARUS_FOURCC, AGLControlInfo_FOURCC);
+  System.FreeMem(Info);
+end;
+
+function GetAGLContext(Control: ControlRef): TAGLContext;
+begin
+  Result:=GetAGLControlInfo(Control)^.AGLContext;
 end;
 
 end.

components/opengl/lazopenglcontext.lpk

@@ -14,7 +14,7 @@
         <CompilerPath Value="$(CompPath)"/>
       </Other>
     </CompilerOptions>
-    <Files Count="3">
+    <Files Count="4">
       <Item1>
         <Filename Value="openglcontext.pas"/>
         <HasRegisterProc Value="True"/>
@@ -30,6 +30,11 @@
         <AddToUsesPkgSection Value="False"/>
         <UnitName Value="GLCarbonAGLContext"/>
       </Item3>
+      <Item4>
+        <Filename Value="agl.pp"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="agl"/>
+      </Item4>
     </Files>
     <Type Value="RunAndDesignTime"/>
     <RequiredPkgs Count="2">

components/opengl/openglcontext.pas

@@ -18,7 +18,7 @@
       - gtk with glx    : fully
       - gtk2 with glx   : todo
       - carbon with agl : todo
-      - windows with ?  : todo
+      - windows with wgl: todo
 }
 unit OpenGLContext;
 

components/synedit/syntextdrawer.pp

@@ -729,7 +729,8 @@ begin
     {$ENDIF}
   end;
   {$IFDEF SYN_LAZARUS}
-  //debugln('TheFontStock.InternalCreateFont A ',FBaseFontName);
+  //debugln('TheFontStock.InternalCreateFont ------------------------------');
+  //debugln('TheFontStock.InternalCreateFont A ',FBaseFontName,' ',dbgs(AStyle));
   Result := CreateFontIndirectEx(FBaseLF,FBaseFontName);
   {$ELSE}
   Result := CreateFontIndirect(FBaseLF);
@@ -833,7 +834,11 @@ begin
   {$ELSE}
   ASSERT(SizeOf(TFontStyles) = 1);
   {$ENDIF}
+  {$IFDEF SYN_LAZARUS}
+  idx := integer(Value);
+  {$ELSE}
   idx := PByte(@Value)^;
+  {$ENDIF}
   ASSERT(idx <= High(TheStockFontPatterns));
 
   UseFontHandles;
@@ -1129,7 +1134,11 @@ procedure TheTextDrawer2.SetStyle(Value: TFontStyles);
 var
   idx: Integer;
 begin
+  {$IFDEF SYN_LAZARUS}
+  idx := integer(Value);
+  {$ELSE}
   idx := PByte(@Value)^;
+  {$ENDIF}
   if FFonts[idx] <> 0 then
   begin
     FCrntFont := FFonts[idx];

ide/codetemplatesdlg.pas

@@ -331,9 +331,10 @@ function CodeMakroProcedureName(const Parameter: string;
   InteractiveValue: TPersistent; SrcEdit: TSourceEditorInterface; var Value,
   ErrorMsg: string): boolean;
 begin
-  Result:=CodeMakroProcedureName(
+  Result:=CodeMakroProcedureHead(
                           'WithoutParamList,WithoutBrackets,WithoutSemicolon',
                           InteractiveValue,SrcEdit,Value,ErrorMsg);
+  debugln('CodeMakroProcedureName ',Value);
 end;
 
 procedure RegisterStandardCodeTemplatesMenuItems;
@@ -390,7 +391,7 @@ begin
     @CodeMakroProcedureHead,nil);
   RegisterCodeMacro('ProcedureName','insert procedure name',
                     'Insert name of current procedure',
-                    @CodeMakroProcedureHead,nil);
+                    @CodeMakroProcedureName,nil);
 end;
 
 { TCodeTemplateEditForm }

ide/compileroptions.pp

@@ -1221,6 +1221,8 @@ begin
       OutFilename:=TargetFilename
     else
       OutFilename:=lowercase(ExtractFileNameOnly(MainSourceFileName));
+    debugln('TBaseCompilerOptions.CreateTargetFilename MainSourceFileName=',MainSourceFileName,' OutFilename=',OutFilename,' TargetFilename=',TargetFilename);
+
     Result:=AppendPathDelim(UnitOutDir)+OutFilename;
   end;
   Result:=TrimFilename(Result);

ide/main.pp

@@ -7258,7 +7258,8 @@ begin
     end;
 
     // execute compilation tool 'Before'
-    ToolBefore:=TProjectCompilationToolOptions(Project1.CompilerOptions.ExecuteBefore);
+    ToolBefore:=TProjectCompilationToolOptions(
+                                        Project1.CompilerOptions.ExecuteBefore);
     if (AReason in ToolBefore.CompileReasons) then begin
       Result:=DoExecuteCompilationTool(Project1.CompilerOptions.ExecuteBefore,
                                        Project1.ProjectDirectory,

lcl/graphics.pp

@@ -1375,10 +1375,29 @@ const
 (***************************************************************************
  ***************************************************************************)
 
+function DbgS(const Style: TFontStyles): string; overload;
+
 procedure Register;
 
 implementation
 
+function DbgS(const Style: TFontStyles): string;
+
+  procedure Add(const s: string);
+  begin
+    if Result<>'' then Result:=Result+',';
+    Result:=Result+s;
+  end;
+
+begin
+  Result:='';
+  if fsBold in Style then Add('fsBold');
+  if fsItalic in Style then Add('fsItalic');
+  if fsStrikeOut in Style then Add('fsStrikeOut');
+  if fsUnderline in Style then Add('fsUnderline');
+  Result:='['+Result+']';
+end;
+
 procedure Register;
 begin
   RegisterClasses([TBitmap,TPixmap,TPortableNetworkGraphic,TPortableAnyMapGraphic,TPicture,

lcl/interfaces/carbon/carbonproc.pp

@@ -30,7 +30,7 @@ unit CarbonProc;
 interface
 
 uses
-  FPCMacOSAll,
+  FPCMacOSAll, Classes,
   LCLProc, LCLClasses, Controls, LMessages, Forms, Avl_Tree, SysUtils,
   CarbonDef;
 
@@ -43,7 +43,10 @@ function DeliverMessage(ATarget: TObject; var AMessage): Integer;
 function RegisterEventHandler(AHandler: TCarbonWSEventHandlerProc): EventHandlerUPP;
 procedure UnRegisterEventHandler(AHandler: TCarbonWSEventHandlerProc);
 
-function Dbgs(const ARect: FPCMacOSAll.Rect): string;
+function GetCarbonRect(Left, Top, Width, Height: Integer): FPCMacOSAll.Rect;
+function GetCarbonRect(const ARect: TRect): FPCMacOSAll.Rect;
+
+function Dbgs(const ARect: FPCMacOSAll.Rect): string; overload;
 
 implementation
 
@@ -216,6 +219,22 @@ begin
   UPPTree.Delete(node);
 end;
 
+function GetCarbonRect(Left, Top, Width, Height: Integer): FPCMacOSAll.Rect;
+begin
+  Result.left:=Left;
+  Result.top:=Top;
+  Result.right:=Left+Width;
+  Result.bottom:=Top+Height;
+end;
+
+function GetCarbonRect(const ARect: TRect): FPCMacOSAll.Rect;
+begin
+  Result.left:=ARect.Left;
+  Result.top:=ARect.Top;
+  Result.right:=ARect.Right;
+  Result.bottom:=ARect.Bottom;
+end;
+
 function Dbgs(const ARect: FPCMacOSAll.Rect): string;
 begin
   Result:=IntToStr(ARect.left)+','+IntToStr(ARect.top)

lcl/interfaces/carbon/carbonwsbuttons.pp

@@ -75,16 +75,14 @@ var
   //Button: TCustomButton;
   Control: ControlRef;
   CFString: CFStringRef;
-  R: Rect;
+  R: FPCMacOSAll.Rect;
   Info: PWidgetInfo;
 begin
   Result := 0;
   //Button := AWinControl as TCustomButton;
 
-  R.Left := AParams.X;
+  R:=GetCarbonRect(AParams.X,AParams.Y,
-  R.Top := AParams.Y;
+                   AParams.X + AParams.Width,AParams.Y + AParams.Height);
-  R.Right := AParams.X + AParams.Width;
-  R.Bottom := AParams.Y + AParams.Height;
 
   CFString := CFStringCreateWithCString(nil, Pointer(AParams.Caption),
                                         DEFAULT_CFSTRING_ENCODING);

lcl/interfaces/carbon/carbonwscontrols.pp

@@ -30,7 +30,7 @@ uses
   // libs
   FPCMacOSAll, CarbonUtils, CarbonExtra, Classes,
   // LCL
-  Controls, LCLType, LMessages, LCLProc,
+  Forms, Controls, LCLType, LMessages, LCLProc,
   // widgetset
   WSControls, WSLCLClasses, WSProc,
   // interface
@@ -83,6 +83,7 @@ type
   private
   protected
   public
+    class function  CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
   end;
 
   { TCarbonWSImageList }
@@ -133,17 +134,31 @@ class procedure TCarbonWSWinControl.SetBounds(const AWinControl: TWinControl;
   const ALeft, ATop, AWidth, AHeight: Integer);
 var
   NewBounds: FPCMacOSAll.Rect;
+  //OldBounds: FPCMacOSAll.Rect;
 begin
-  if not WSCheckHandleAllocated(AWinControl, 'GetText') then Exit;
+  if not WSCheckHandleAllocated(AWinControl, 'SetBounds') then Exit;
 
   NewBounds.left:=AWinControl.Left;
   NewBounds.top:=AWinControl.Top;
   NewBounds.right:=AWinControl.Left+AWinControl.Width;
   NewBounds.bottom:=AWinControl.Top+AWinControl.Height;
   DebugLn('TCarbonWSWinControl.SetBounds ',dbgsName(AWinControl),' NewBounds=',dbgs(NewBounds));
-  if SetWindowBounds(WindowRef(AWinControl.Handle),kWindowStructureRgn,NewBounds)
+  if AWinControl is TCustomForm then begin
-  <> NoErr then begin
+    if SetWindowBounds(WindowRef(AWinControl.Handle),kWindowStructureRgn,NewBounds)
-    DebugLn('TCarbonWSWinControl.SetBounds ',dbgsName(AWinControl),' failed');
+    <> NoErr then begin
+      DebugLn('TCarbonWSWinControl.SetBounds ',dbgsName(AWinControl),' failed');
+    end;
+  end else begin
+    //GetControlBounds(ControlRef(AWinControl.Handle),OldBounds);
+    //debugln('TCarbonWSWinControl.SetBounds OldBounds=',dbgs(OldBounds));
+    SetControlBounds(ControlRef(AWinControl.Handle),NewBounds);
+    {if AWinControl.Parent<>nil then begin
+      dec(OldBounds.Left,10);
+      dec(OldBounds.Top,10);
+      inc(OldBounds.right,10);
+      inc(OldBounds.bottom,10);
+      InvalWindowRect(WindowRef(AWinControl.Parent.Handle),OldBounds);
+    end;}
   end;
 end;
 
@@ -198,6 +213,36 @@ begin
   ARect.Bottom := ARect.Top + Trunc(AHIRect.size.height);
 end;
 
+{ TCarbonWSCustomControl }
+
+function TCarbonWSCustomControl.CreateHandle(const AWinControl: TWinControl;
+  const AParams: TCreateParams): TLCLIntfHandle;
+var
+  //Button: TCustomButton;
+  Control: ControlRef;
+  CFString: CFStringRef;
+  R: FPCMacOSAll.Rect;
+  Info: PWidgetInfo;
+begin
+  Result := 0;
+  //Button := AWinControl as TCustomButton;
+
+  R:=GetCarbonRect(AParams.X,AParams.Y,
+                   AParams.X + AParams.Width,AParams.Y + AParams.Height);
+
+  CFString := CFStringCreateWithCString(nil, Pointer(AParams.Caption),
+                                        DEFAULT_CFSTRING_ENCODING);
+  if CreatePushButtonControl(WindowRef(AParams.WndParent), R,
+    CFString, Control) = noErr
+  then
+    Result := TLCLIntfHandle(Control);
+  CFRelease(Pointer(CFString));
+  if Result = 0 then Exit;
+
+  Info := CreateWidgetInfo(Control, AWinControl);
+  TCarbonPrivateHandleClass(WSPrivate).RegisterEvents(Info);
+end;
+
 initialization
 
 ////////////////////////////////////////////////////
@@ -210,7 +255,7 @@ initialization
 //  RegisterWSComponent(TControl, TCarbonWSControl);
   RegisterWSComponent(TWinControl, TCarbonWSWinControl, TCarbonPrivateHiView);
 //  RegisterWSComponent(TGraphicControl, TCarbonWSGraphicControl);
-//  RegisterWSComponent(TCustomControl, TCarbonWSCustomControl);
+  RegisterWSComponent(TCustomControl, TCarbonWSCustomControl);
 //  RegisterWSComponent(TImageList, TCarbonWSImageList);
 ////////////////////////////////////////////////////
 

lcl/interfaces/carbon/carbonwsforms.pp

@@ -128,6 +128,8 @@ var
   NewBounds: FPCMacOSAll.Rect;
   Info: PWidgetInfo;
   NewWindowClass: Integer;
+  MinSize: HISize;
+  MaxSize: HISize;
 begin
   Result := 0;
 
@@ -157,6 +159,16 @@ begin
 
   Info := CreateWidgetInfo(Window, AWinControl);
   TCarbonPrivateHandleClass(WSPrivate).RegisterEvents(Info);
+  
+  MinSize.width:=AWinControl.Constraints.EffectiveMinWidth;
+  MinSize.height:=AWinControl.Constraints.EffectiveMinHeight;
+  MaxSize.width:=AWinControl.Constraints.EffectiveMaxWidth;
+  MaxSize.height:=AWinControl.Constraints.EffectiveMaxHeight;
+  if MaxSize.width<=0 then
+    MaxSize.width:=10000;
+  if MaxSize.height<=0 then
+    MaxSize.height:=10000;
+  SetWindowResizeLimits(Window,@MinSize,@MaxSize);
 
   // The window was created hidden so show it.
   ShowWindow(Window);

lcl/interfaces/gtk/gtkcallback.inc

@@ -1594,6 +1594,7 @@ var
   FileName : string;
   Files: TStringList;
   CurFilename: string;
+  //SelectedFont: PGdkFont;
 
   function CheckOpenedFilename(const AFilename: string): boolean;
   begin
@@ -1709,6 +1710,10 @@ begin
     Assert(False, 'Trace:Pressed OK in FontDialog');
     FontName := gtk_font_selection_dialog_get_font_name(
                                              pgtkfontselectiondialog(FPointer));
+    //debugln('gtkDialogOKclickedCB FontName=',FontName);
+    //SelectedFont:=gdk_font_load(PChar(FontName));
+    //debugln('gtkDialogOKclickedCB ',dbgs(SelectedFont));
+
     // extract basic font attributes from the font name in XLFD format
     ALogFont:=XLFDNameToLogFont(FontName);
     TFontDialog(theDialog).Font.Assign(ALogFont);

lcl/interfaces/gtk/gtkwinapi.inc

@@ -1275,6 +1275,8 @@ begin
   Result:=0;
 end;
 {$Else}
+
+{off $DEFINE VerboseFonts}
 var
   GdiObject: PGdiObject;
   FontNameRegistry, Foundry, FamilyName, WeightName,
@@ -1320,8 +1322,7 @@ var
        CharSetRegistry, CharSetCoding
       ]);}
 
-    //DebugLn('  Trying "',S,'"');
+    //DebugLn('  Trying Font "',S,'"');
-    DebugLn('  Trying Font "',S,'"');
     result := LoadFontXLFD(S);
   end;
 
@@ -1335,6 +1336,7 @@ var
     Tail := '-'+SetwidthName+'-'+AddStyleName+'-'+PixelSize
            +'-'+PointSize+'-'+ResolutionX+'-'+ResolutionY+'-'+Spacing
            +'-'+AverageWidth+'-'+CharSetRegistry+'-'+CharSetCoding;
+    //debugln('LoadFontExCharset Head=',Head,' Tail=',Tail);
     for i:=0 to WeightList.Count-1 do begin
       aSlant := Slant;
       repeat
@@ -1347,6 +1349,7 @@ var
           break;
       until false;
     end;
+    //debugln('LoadFontExCharset END');
   end;
   
   function LoadFontEx: boolean;
@@ -1354,6 +1357,7 @@ var
     j: integer;
   begin
     Result := false;
+    //debugln('LoadFontEx START CharSetRegistry=',CharSetRegistry);
     if CharSetRegistry<>'*' then
       result := LoadFontExCharset
     else
@@ -1367,6 +1371,7 @@ var
         if result then
           break;
       end;
+    //debugln('LoadFontEx END');
   end;
 
   procedure LoadDefaultFont;
@@ -1649,7 +1654,7 @@ begin
     // next checks are fall over
 
     {$IFDEF VerboseFonts}
-    write('CreateFontIndirect->');
+    debugln('TGtkWidgetSet.CreateFontIndirectEx ');
     {$ENDIF}
     {
     if LoadFont then exit;
@@ -1658,11 +1663,23 @@ begin
     WeightName := '*';
     if LoadFont then exit;
     }
-    // try one height lower
+    // try one height smaller
+    {$IFDEF VerboseFonts}
+    debugln('TGtkWidgetSet.CreateFontIndirectEx try one height smaller');
+    {$ENDIF}
     PixelSize := IntToStr(Abs(LogFont.lfHeight)-1);
+    // Since we use pixelsize, it isn't allowed to give a value here
+    PointSize := '*';
+
+    // Use the default
+    ResolutionX := '*';
+    ResolutionY := '*';
     if LoadFont then exit;
 
-    // try one height higher
+    // try one height bigger
+    {$IFDEF VerboseFonts}
+    debugln('TGtkWidgetSet.CreateFontIndirectEx try one height bigger');
+    {$ENDIF}
     PixelSize := IntToStr(Abs(LogFont.lfHeight)+1);
     if LoadFont then exit;
 
@@ -1670,6 +1687,9 @@ begin
 
     // try instead of mono spaced -> character cell spaced
     if (Spacing='m') then begin
+      {$IFDEF VerboseFonts}
+      debugln('TGtkWidgetSet.CreateFontIndirectEx try instead of mono spaced -> character cell spaced');
+      {$ENDIF}
       Spacing:='c';
       if LoadFont then exit;
     end;
@@ -1686,11 +1706,17 @@ begin
     }
     // try all spacings
     if spacing<>'*' then begin
+      {$IFDEF VerboseFonts}
+      debugln('TGtkWidgetSet.CreateFontIndirectEx try all spacings');
+      {$ENDIF}
       Spacing := '*';
       if LoadFont then exit;
     end;
 
     if charSetCoding<>'*' then begin
+      {$IFDEF VerboseFonts}
+      debugln('TGtkWidgetSet.CreateFontIndirectEx try all charsets');
+      {$ENDIF}
       charsetCoding := '*';
       charSetRegistry:= '*';
       if LoadFont then exit;
@@ -1698,6 +1724,9 @@ begin
 
     if (Foundry<>'*') then begin
       // try all Families
+      {$IFDEF VerboseFonts}
+      debugln('TGtkWidgetSet.CreateFontIndirectEx try all families');
+      {$ENDIF}
       PixelSize := IntToStr(Abs(LogFont.lfHeight));
       FamilyName := '*';
       if LoadFont then exit;

lcl/lclproc.pas

@@ -147,24 +147,24 @@ procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10: string);
 procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11: string);
 procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12: string);
 
-function DbgS(const c: cardinal): string;
+function DbgS(const c: cardinal): string; overload;
-function DbgS(const i: longint): string;
+function DbgS(const i: longint): string; overload;
-function DbgS(const i: int64): string;
+function DbgS(const i: int64): string; overload;
-function DbgS(const r: TRect): string;
+function DbgS(const r: TRect): string; overload;
-function DbgS(const p: TPoint): string;
+function DbgS(const p: TPoint): string; overload;
-function DbgS(const p: pointer): string;
+function DbgS(const p: pointer): string; overload;
-function DbgS(const e: extended): string;
+function DbgS(const e: extended): string; overload;
-function DbgS(const b: boolean): string;
+function DbgS(const b: boolean): string; overload;
-function DbgSName(const p: TObject): string;
+function DbgSName(const p: TObject): string; overload;
-function DbgSName(const p: TClass): string;
+function DbgSName(const p: TClass): string; overload;
-function DbgStr(const StringWithSpecialChars: string): string;
+function DbgStr(const StringWithSpecialChars: string): string; overload;
-function DbgWideStr(const StringWithSpecialChars: widestring): string;
+function DbgWideStr(const StringWithSpecialChars: widestring): string; overload;
-function dbgMemRange(P: PByte; Count: integer; Width: integer = 0): string;
+function dbgMemRange(P: PByte; Count: integer; Width: integer = 0): string; overload;
-function dbgMemStream(MemStream: TCustomMemoryStream; Count: integer): string;
+function dbgMemStream(MemStream: TCustomMemoryStream; Count: integer): string; overload;
-function dbgObjMem(AnObject: TObject): string;
+function dbgObjMem(AnObject: TObject): string; overload;
 
-function DbgS(const i1,i2,i3,i4: integer): string;
+function DbgS(const i1,i2,i3,i4: integer): string; overload;
-function DbgS(const Shift: TShiftState): string;
+function DbgS(const Shift: TShiftState): string; overload;
 
 // some string manipulation functions
 function StripLN(const ALine: String): String;
@@ -831,6 +831,7 @@ end;
 procedure InitializeDebugOutput;
 var
   DebugFileName: string;
+  
   function GetDebugFileName: string;
   const
     DebugLogStart = '--debug-log=';
@@ -855,6 +856,7 @@ var
     if (length(result)>0) then
       Result := ExpandFileName(Result);
   end;
+  
 begin
   DebugFileName := GetDebugFileName;
   if (length(DebugFileName)>0) and