LCL-CustomDrawn-X11: Advances the font chooser

git-svn-id: trunk@35706 -

lcl/interfaces/customdrawn/customdrawnint.pas

@@ -31,6 +31,9 @@ uses
   // RTL
   Types, Classes, SysUtils, Math,
   fpimage, fpcanvas, fpimgcanv, ctypes, dateutils,
+  // XML
+  XMLRead, Dom,
+  // Platform specific
   {$ifdef CD_Windows}Windows, customdrawn_WinProc,{$endif}
   {$ifdef CD_Cocoa}MacOSAll, CocoaAll, CocoaPrivate, CocoaGDIObjects,{$endif}
   {$ifdef CD_X11}X, XLib, XUtil, BaseUnix, customdrawn_x11proc,{$ifdef CD_UseNativeText}xft, fontconfig,{$endif}{$endif}
@@ -38,12 +41,14 @@ uses
   customdrawn_androidproc, jni, bitmap, log, keycodes,
   {$endif}
   {$ifdef WinCE}aygshell,{$endif}
-  // Widgetset
-  customdrawnproc,
+  // LazUtils
+  fileutil, lazutf8,
   {$ifndef CD_UseNativeText}
   // LazFreeType
   LazFreeTypeIntfDrawer, LazFreeType, EasyLazFreeType,
   {$endif}
+  // Widgetset
+  customdrawnproc,
   // LCL
   customdrawn_common, customdrawncontrols, customdrawndrawers,
   lazcanvas, lazregions, lazdeviceapis,

lcl/interfaces/customdrawn/customdrawnproc.pas

@@ -8,6 +8,8 @@ uses
   // rtl+ftl
   Types, Classes, SysUtils,
   fpimage, fpcanvas, Math,
+  // LazUtils
+  fileutil,
   // Custom Drawn Canvas
   IntfGraphics, lazcanvas, lazregions,
   // LCL
@@ -154,6 +156,10 @@ function GetSmallestTimerInterval(): Integer;
 procedure RemoveTimer(ATimer: TCDTimer);
 function FindTimerWithNativeHandle(ANativeHandle: PtrInt): TCDTimer;
 
+// Font choosing routines
+
+procedure VerifyAndCleanUpFontDirectories(AFontDirectories: TStringList);
+
 implementation
 
 var
@@ -691,6 +697,44 @@ begin
   end;
 end;
 
+procedure VerifyAndCleanUpFontDirectories(AFontDirectories: TStringList);
+var
+  i, j: Integer;
+begin
+  // Add path delimitiers to the end of all paths
+  for i := 0 to AFontDirectories.Count -1 do
+  begin
+    AFontDirectories.Strings[i] := IncludeTrailingPathDelimiter(AFontDirectories.Strings[i]);
+  end;
+
+  // remove all duplicates
+  i := 0;
+  while i < AFontDirectories.Count do
+  begin
+    j := i+1;
+    while j < AFontDirectories.Count do
+    begin
+      if AFontDirectories.Strings[i] = AFontDirectories.Strings[j] then
+        AFontDirectories.Delete(j);
+      Inc(j);
+    end;
+    Inc(i);
+  end;
+
+  // Now remove all directories which don't exist
+  i := 0;
+  while i < AFontDirectories.Count do
+  begin
+    if not DirectoryExistsUTF8(AFontDirectories.Strings[i]) then
+      AFontDirectories.Delete(i);
+    Inc(i);
+  end;
+
+  // Raise an exception if there are no font directories
+  if AFontDirectories.Count = 0 then
+    raise Exception.Create('[VerifyAndCleanUpFontDirectories] After cleaning up no font directories were found.');
+end;
+
 { TCDBitmap }
 
 destructor TCDBitmap.Destroy;

lcl/interfaces/customdrawn/customdrawnwinapi_cocoa.inc

@@ -159,6 +159,11 @@ begin
 end;*)
 
 {$ifndef CD_UseNativeText}
+procedure TCDWidgetSet.BackendListFontPaths(var AFontPaths: TStringList);
+begin
+  AFontPaths.Add('/Library/Fonts/');
+end;
+
 function TCDWidgetSet.BackendGetFontPath(const LogFont: TLogFont; const LongFontName: string): string;
 begin
   Result := '/Library/Fonts/Arial.ttf';

lcl/interfaces/customdrawn/customdrawnwinapi_x11.inc

@@ -631,9 +631,79 @@ begin
 end;*)
 
 {$ifndef CD_UseNativeText}
-function TCDWidgetSet.BackendGetFontPath(const LogFont: TLogFont; const LongFontName: string): string;
+procedure TCDWidgetSet.BackendListFontPaths(var AFontPaths: TStringList);
+var
+  Doc: TXMLDocument;
+  lFontDirectories: TStringList;
+  i, FontsCount: cint;
+  lXFontPath: PPChar;
+  XMLFontConfig, XMLDir: TDOMNode;
+  XMLFontConfigChilds: TDOMNodeList;
+const
+  GlobalFontsConfFile = '/etc/fonts/fonts.conf';
 begin
-  Result := '/usr/share/fonts/TTF/liberation/LiberationSans-Regular.ttf';
+  // First paths from X11
+  lXFontPath := XGetFontPath(FDisplay, @FontsCount);
+  for i := 0 to FontsCount-1 do
+    AFontPaths.Add(lXFontPath[i]);
+  XFreeFontPath(lXFontPath);
+
+  // Paths from the global config file
+  if FileUtil. FileExistsUTF8(GlobalFontsConfFile) then
+  begin
+    try
+      ReadXMLFile(Doc, GlobalFontsConfFile);
+      XMLFontConfig := Doc.DocumentElement.FirstChild; // the tag <fontconfig>
+      if Assigned(XMLFontConfig) then
+      begin
+        XMLFontConfigChilds := XMLFontConfig.ChildNodes;
+        for i := 0 to XMLFontConfigChilds.Count-1 do
+          if UTF8CompareText(XMLFontConfigChilds.Item[i].NodeName, 'dir') = 0 then
+            AFontPaths.Add(XMLFontConfigChilds.Item[i].FirstChild.NodeValue);
+      end;
+    finally
+      XMLFontConfig.Free;
+      Doc.Free;
+    end;
+  end;
+
+  // Add a good standards too in case the list is empty
+  AFontPaths.Add('/usr/share/fonts/');
+  AFontPaths.Add('/usr/lib/X11/fonts/');
+  AFontPaths.Add('/usr/X11R6/lib/X11/fonts/');
+  AFontPaths.Add('/opt/ttfonts/');
+  AFontPaths.Add('/usr/share/fonts/TTF/liberation/');
+
+  // Now clear up the list, make sure all paths end with a path delim, etc
+  VerifyAndCleanUpFontDirectories(AFontPaths);
+end;
+
+function TCDWidgetSet.BackendGetFontPath(const LogFont: TLogFont; const LongFontName: string): string;
+var
+  lFontPaths: TStringList;
+  i: Integer;
+  Str: String;
+begin
+  lFontPaths := TStringList.Create;
+  try
+    BackendListFontPaths(lFontPaths);
+
+    // Classify and choose the fonts
+    // ToDo
+
+    // Fallback: Search for known fallback fonts
+    for i := 0 to lFontPaths.Count -1 do
+    begin
+      Str := lFontPaths.Strings[i] + 'LiberationSans-Regular.ttf';
+      if FileExistsUTF8(Str) then
+      begin
+        Result := Str;
+        Break;
+      end;
+    end;
+  finally
+    lFontPaths.Free;
+  end;
 end;
 {$endif}
 

lcl/interfaces/customdrawn/customdrawnwinapih.inc

@@ -64,6 +64,7 @@ function CreateCompatibleDC(DC: HDC): HDC; override;
 function CreateFontIndirect(const LogFont: TLogFont): HFONT; override;
 function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; override;
 {$ifndef CD_UseNativeText}
+procedure BackendListFontPaths(var AFontPaths: TStringList);
 function BackendGetFontPath(const LogFont: TLogFont; const LongFontName: string): string;
 {$endif}
 function CreateIconIndirect(IconInfo: PIconInfo): HICON; override;