Added files from Mac-Friendly article; updated dfmtolfm.pas with -m switch

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1375 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/xdev_toolkit/CFHelpers.pas

@@ -0,0 +1,110 @@
+unit CFHelpers;
+
+{
+  Unit of handy routines for use with Core Foundation.
+
+  CFStrToAnsiStr was adapted from the Lazarus CarbonProc unit's
+   CFStringToStr function.
+  License: Modified LGPL.
+  
+  Note that objects returned by functions with "Create" or "Copy"
+   in the function name need to be released by the calling code.
+   For example, CFStringCreateWithCString is called in AnsiStrToCFStr,
+   meaning this applies to code that calls AnsiStrToCFStr as well.
+  FreeCFRef and FreeAndNilCFRef are convenience routines provided 
+   for that purpose.
+  See Apple docs for more information on the so-called Create Rule 
+   and Get Rule: 
+  https://developer.apple.com/library/mac/#documentation/CoreFoundation/
+          Conceptual/CFMemoryMgmt/Concepts/Ownership.html
+}
+
+{$MODE Delphi}
+
+interface
+
+uses
+  MacOSAll;
+  
+function CFStrToAnsiStr(cfStr    : CFStringRef;
+                        encoding : CFStringEncoding = kCFStringEncodingWindowsLatin1): AnsiString;
+
+procedure AnsiStrToCFStr(const aStr     : AnsiString;
+                           out cfStr    : CFStringRef;
+                               encoding : CFStringEncoding = kCFStringEncodingWindowsLatin1);
+
+procedure FreeCFRef(var cfRef: CFTypeRef);
+
+procedure FreeAndNilCFRef(var cfRef : CFTypeRef);
+
+
+implementation
+
+function CFStrToAnsiStr(cfStr    : CFStringRef;
+                        encoding : CFStringEncoding = kCFStringEncodingWindowsLatin1): AnsiString;
+ {Convert CFString to AnsiString.
+  If encoding is not specified, use CP1252 by default.}
+var
+  StrPtr   : Pointer;
+  StrRange : CFRange;
+  StrSize  : CFIndex;
+begin
+  if cfStr = nil then
+    begin
+    Result := '';
+    Exit;
+    end;
+
+   {First try the optimized function}
+  StrPtr := CFStringGetCStringPtr(cfStr, encoding);
+  if StrPtr <> nil then  {Succeeded?}
+    Result := PChar(StrPtr)
+  else  {Use slower approach - see comments in CFString.pas}
+    begin
+    StrRange.location := 0;
+    StrRange.length := CFStringGetLength(cfStr);
+
+     {Determine how long resulting string will be}
+    CFStringGetBytes(cfStr, StrRange, encoding, Ord('?'),
+                     False, nil, 0, StrSize);
+    SetLength(Result, StrSize);  {Expand string to needed length}
+
+    if StrSize > 0 then  {Convert string?}
+      CFStringGetBytes(cfStr, StrRange, encoding, Ord('?'),
+                       False, @Result[1], StrSize, StrSize);
+    end;
+end;  {CFStrToAnsiStr}
+
+
+procedure AnsiStrToCFStr(const aStr     : AnsiString;
+                           out cfStr    : CFStringRef;
+                               encoding : CFStringEncoding = kCFStringEncodingWindowsLatin1);
+ {Create CFString from AnsiString.
+  If encoding is not specified, use CP1252 by default.
+  Note: Calling code is responsible for calling CFRelease on 
+   returned CFString. Presumably that's the reason why CarbonProc 
+   unit's CreateCFString is a procedure, so you don't use it in 
+   an expression and leave the CFString dangling.}
+begin
+  cfStr := CFStringCreateWithCString(nil, Pointer(PChar(aStr)), encoding);
+end;
+
+
+procedure FreeCFRef(var cfRef : CFTypeRef);
+ {Convenience routine to free a CF reference so you don't have
+   to check if it's nil.}
+begin
+  if Assigned(cfRef) then
+    CFRelease(cfRef);
+end;
+
+
+procedure FreeAndNilCFRef(var cfRef : CFTypeRef);
+ {Convenience routine to free a CF reference and set it to nil.}
+begin
+  FreeCFRef(cfRef);
+  cfRef := nil;
+end;
+
+
+end.

components/xdev_toolkit/PrefsUtil.pas

@@ -0,0 +1,207 @@
+unit PrefsUtil;
+
+{
+
+  Class for working with application preferences.
+
+  Author:    Phil Hess.
+  Copyright: Copyright (C) 2010 Phil Hess. All rights reserved.
+  License:   Modified LGPL. This means you can link your code to this
+             compiled unit (statically in a standalone executable or 
+             dynamically in a library) without releasing your code. Only
+             changes to this unit need to be made publicly available.
+
+}
+
+{$MODE Delphi}
+
+interface
+
+uses
+  MacOSAll,
+  CFHelpers;  {Handy routines for use with Core Foundation}
+  
+type  {Note: Not all CF object types are supported yet by this class}
+  TCFPreferences = class(TObject)
+  private
+    function GetAppValue(const KeyName : string) : CFPropertyListRef;
+  public
+    destructor Destroy; override;
+    function AppHasKey(const KeyName : string) : Boolean;
+    function GetAppString(const KeyName : string) : string;
+    function GetAppStringDef(const KeyName : string;
+                             const Default : string) : string;
+    procedure SetAppString(const KeyName : string;
+                           const Value   : string);
+    function GetAppBoolean(const KeyName : string) : Boolean;
+    function GetAppBooleanDef(const KeyName : string;
+                                    Default : Boolean) : Boolean;
+    procedure SetAppBoolean(const KeyName : string;
+                                  Value   : Boolean);
+    procedure DeleteAppKey(const KeyName : string);
+    end;
+
+
+implementation
+
+destructor TCFPreferences.Destroy;
+ {Write any changes to preferences file.}
+begin
+  CFPreferencesAppSynchronize(kCFPreferencesCurrentApplication);
+  inherited Destroy;
+end;
+
+
+function TCFPreferences.GetAppValue(const KeyName : string) : CFPropertyListRef;
+ {Get key's value for preference domain "Current User, Current 
+   Application, Any Host."}
+var
+  KeyRef : CFStringRef;
+begin
+  AnsiStrToCFStr(KeyName, KeyRef);
+  try
+    Result := 
+     CFPreferencesCopyAppValue(KeyRef, kCFPreferencesCurrentApplication);
+  finally
+    FreeCFRef(KeyRef);
+    end;
+end;
+
+
+function TCFPreferences.AppHasKey(const KeyName : string) : Boolean;
+ {Return True if key exists in preference domain "Current User, Current 
+   Application, Any Host."}
+var
+  ValueRef : CFPropertyListRef;
+begin
+  Result := False;
+  try
+    ValueRef := GetAppValue(KeyName);
+    if Assigned(ValueRef) then
+      Result := True;
+  finally
+    FreeCFRef(ValueRef);
+    end;
+end;
+
+
+function TCFPreferences.GetAppString(const KeyName : string) : string;
+ {Get key's string value for preference domain "Current User, Current 
+   Application, Any Host."
+  If key does not exist, returns blank string.}
+var
+  ValueRef : CFPropertyListRef;
+begin
+  Result := '';
+  try
+    ValueRef := GetAppValue(KeyName);
+    if Assigned(ValueRef) and 
+       (CFGetTypeID(ValueRef) = CFStringGetTypeID) then  {Value is a string?}
+      Result := CFStrToAnsiStr(ValueRef);
+  finally
+    FreeCFRef(ValueRef);
+    end;
+end;
+
+
+function TCFPreferences.GetAppStringDef(const KeyName : string;
+                                        const Default : string) : string;
+ {Get key's string value for preference domain "Current User, Current 
+   Application, Any Host."
+  If key does not exist, returns Default.}
+begin
+  if AppHasKey(KeyName) then
+    Result := GetAppString(KeyName)
+  else
+    Result := Default;
+end;
+
+
+procedure TCFPreferences.SetAppString(const KeyName : string;
+                                      const Value   : string);
+ {Set key's string value in preference domain "Current User, Current 
+   Application, Any Host."}
+var
+  KeyRef   : CFStringRef;
+  ValueRef : CFPropertyListRef;
+begin
+  AnsiStrToCFStr(KeyName, KeyRef);
+  AnsiStrToCFStr(Value, ValueRef);
+  try
+    CFPreferencesSetAppValue(KeyRef, ValueRef, kCFPreferencesCurrentApplication);
+  finally
+    FreeCFRef(KeyRef);
+    FreeCFRef(ValueRef);
+    end;  
+end;
+
+
+function TCFPreferences.GetAppBoolean(const KeyName : string) : Boolean;
+ {Get key's Boolean value for preference domain "Current User, Current 
+   Application, Any Host."
+  If key does not exist, returns False.}
+var
+  ValueRef : CFPropertyListRef;
+begin
+  Result := False;
+  try
+    ValueRef := GetAppValue(KeyName);
+    if Assigned(ValueRef) and
+       (CFGetTypeID(ValueRef) = CFBooleanGetTypeID) then  {Value is a Boolean?}
+      Result := CFBooleanGetValue(ValueRef);
+  finally
+    FreeCFRef(ValueRef);
+    end;
+end;
+
+
+function TCFPreferences.GetAppBooleanDef(const KeyName : string;
+                                               Default : Boolean) : Boolean;
+ {Get key's Boolean value for preference domain "Current User, Current 
+   Application, Any Host."
+  If key does not exist, returns Default.}
+begin
+  if AppHasKey(KeyName) then
+    Result := GetAppBoolean(KeyName)
+  else
+    Result := Default;
+end;
+
+
+procedure TCFPreferences.SetAppBoolean(const KeyName : string;
+                                             Value   : Boolean);
+ {Set key's Boolean value in preference domain "Current User, Current 
+   Application, Any Host."}
+var
+  KeyRef   : CFStringRef;
+  ValueRef : CFBooleanRef;
+begin
+  AnsiStrToCFStr(KeyName, KeyRef);
+  if Value then
+    ValueRef := kCFBooleanTrue
+  else
+    ValueRef := kCFBooleanFalse;
+  try
+    CFPreferencesSetAppValue(KeyRef, ValueRef, kCFPreferencesCurrentApplication);
+  finally
+    FreeCFRef(KeyRef);
+    end;  
+end;
+
+
+procedure TCFPreferences.DeleteAppKey(const KeyName : string);
+ {Delete key from preference domain "Current User, Current 
+   Application, Any Host."}
+var
+  KeyRef : CFStringRef;
+begin
+  AnsiStrToCFStr(KeyName, KeyRef);
+  try
+    CFPreferencesSetAppValue(KeyRef, nil, kCFPreferencesCurrentApplication);
+  finally
+    FreeCFRef(KeyRef);
+    end;  
+end;
+
+
+end.

components/xdev_toolkit/PropListUtil.pas

@@ -0,0 +1,176 @@
+unit PropListUtil;
+
+{
+
+  Class for working with property list (for example, app bundle's
+   Info.plist).
+
+  Author:    Phil Hess.
+  Copyright: Copyright (C) 2010 Phil Hess. All rights reserved.
+  License:   Modified LGPL. This means you can link your code to this
+             compiled unit (statically in a standalone executable or 
+             dynamically in a library) without releasing your code. Only
+             changes to this unit need to be made publicly available.
+
+}
+
+{$MODE Delphi}
+
+interface
+
+uses
+  MacOSAll,
+  CFHelpers;  {Handy routines for use with Core Foundation}
+  
+type  {Note: Not all CF object types are supported yet by this class}
+  TCFPropertyList = class(TObject)
+  private
+    propertyList : CFPropertyListRef;
+    function GetValue(const KeyName : string) : UnivPtr;
+  public
+    destructor Destroy; override;
+    function LoadFromFile(const FileName : string) : Boolean;
+    function GetString(const KeyName : string) : string;
+    function GetBoolean(const KeyName : string) : Boolean;
+    end;
+
+function GetInfoPlistString(const KeyName : string) : string;
+
+
+implementation
+
+destructor TCFPropertyList.Destroy;
+begin
+  FreeCFRef(propertyList);
+end;
+
+
+function TCFPropertyList.LoadFromFile(const FileName : string) : Boolean;
+ {Adapted from example ObjC code given here: 
+  http://developer.apple.com/library/mac/documentation/Cocoa/
+   Conceptual/PropertyLists/SerializePlist/SerializePlist.html#//
+   apple_ref/doc/uid/10000048i-CH7-SW5}
+var
+  plistFileName : CFStringRef;
+  fileURL       : CFURLRef;
+  resourceData  : CFDataRef;
+  errorCode     : SInt32;
+  errorString   : CFStringRef;
+begin
+  Result := False;
+  
+  FreeAndNilCFRef(propertyList);  {In case something previously loaded}
+
+  AnsiStrToCFStr(FileName, plistFileName);
+
+  fileURL := CFURLCreateWithFileSystemPath(
+              kCFAllocatorDefault,
+              plistFileName,
+              kCFURLPOSIXPathStyle,  {Interpret as POSIX path}
+              False);                {Not a directory}
+   {Note that if file name is not absolute, treated relative
+     to working directory.}
+
+  FreeCFRef(plistFileName);
+
+   {Read the XML file.
+    Note getting resource data, not specified properties.}
+  try
+    if not CFURLCreateDataAndPropertiesFromResource(
+            kCFAllocatorDefault,
+            fileURL,
+            @resourceData,  {Place to put XML file's data}
+            nil,
+            nil,
+            errorCode) then
+      Exit;
+       {Description of function suggests resourceData might
+         be non-null even if failure, so release below.}
+
+     {Reconstitute the dictionary using the XML data.}
+    propertyList := CFPropertyListCreateFromXMLData(
+                     kCFAllocatorDefault,
+                     resourceData,
+                     kCFPropertyListImmutable,
+                     @errorString);
+
+    if Assigned(propertyList) then
+      Result := True
+    else
+      FreeCFRef(errorString);  //return this too?
+  finally
+    FreeCFRef(fileURL);
+    FreeCFRef(resourceData);  
+    end;
+end;  {TCFPropertyList.LoadFromFile}
+
+
+function TCFPropertyList.GetValue(const KeyName : string) : UnivPtr;
+ {Retrieve key's CF value from property list.}
+var
+  KeyRef : CFStringRef;
+begin
+  Result := nil;
+  if not Assigned(propertyList) then  {Error - list not loaded?}
+    Exit;
+  if CFGetTypeID(propertyList) <> CFDictionaryGetTypeID then  {Not valid?}
+    Exit;
+  AnsiStrToCFStr(KeyName, KeyRef);
+  Result := CFDictionaryGetValue(propertyList, KeyRef);
+  FreeCFRef(KeyRef);
+end;
+
+
+function TCFPropertyList.GetString(const KeyName : string) : string;
+ {Retrieve key's string value from property list.}
+var
+  Value : UnivPtr;
+begin
+  Result := '';
+  Value := GetValue(KeyName);
+  if not Assigned(Value) then  {Key not found?}
+    Exit;
+  if CFGetTypeID(Value) = CFStringGetTypeID then  {Value is a string?}
+    Result := CFStrToAnsiStr(Value);
+end;
+
+
+function TCFPropertyList.GetBoolean(const KeyName : string) : Boolean;
+ {Retrieve key's Boolean value from property list.}
+var
+  Value : UnivPtr;
+begin
+  Result := False;
+  Value := GetValue(KeyName);
+  if not Assigned(Value) then  {Key not found?}
+    Exit;
+  if CFGetTypeID(Value) = CFBooleanGetTypeID then  {Value is a Boolean?}
+    Result := CFBooleanGetValue(Value);
+end; 
+
+
+
+function GetInfoPlistString(const KeyName : string) : string;
+ {Retrieve key's string value from app bundle's Info.plist file.}
+var
+  BundleRef : CFBundleRef;
+  KeyRef    : CFStringRef;
+  ValueRef  : CFTypeRef;
+begin
+  Result := '';
+  BundleRef := CFBundleGetMainBundle;
+  if BundleRef = nil then  {Executable not in an app bundle?}
+    Exit;
+  AnsiStrToCFStr(KeyName, KeyRef);
+  try
+    ValueRef := CFBundleGetValueForInfoDictionaryKey(BundleRef, KeyRef);
+    if CFGetTypeID(ValueRef) <> CFStringGetTypeID then  {Value not a string?}
+      Exit;
+    Result := CFStrToAnsiStr(ValueRef);
+  finally
+    FreeCFRef(KeyRef);
+    end;
+end;  {GetInfoPlistString}
+
+
+end.

components/xdev_toolkit/dfmtolfm.ini

@@ -10,7 +10,7 @@
 IsControl=
 ;NumGlyphs=
 OldCreateOrder=
-WantReturns=
+;WantReturns=
 Ctl3D=
 ParentCtl3D=
 OnClickCheck=
@@ -123,3 +123,15 @@ TOvcTCIcon=
 
 TFrameViewer=
 THTMLViewer=
+
+; These controls cannot receive focus on Mac, so with -m switch
+;  add TabStop = False so tabbing skips over them.
+
+[MacNoFocus]
+TButton=
+TBitBtn=
+TComboBox=
+TCheckBox=
+;TListBox=
+;TRadioGroup
+

components/xdev_toolkit/dfmtolfm.pas

@@ -15,7 +15,7 @@ program DfmToLfm;
    (a one-time conversion).
    
   Author:    Phil Hess.
-  Copyright: Copyright (C) 2007 Phil Hess. All rights reserved.
+  Copyright: Copyright (C) 2007-2010 Phil Hess. All rights reserved.
   License:   Modified LGPL.
 }
 
@@ -32,7 +32,7 @@ uses
 
 const
   ProgramName    = 'DfmToLfm';
-  ProgramVersion = '0.02';
+  ProgramVersion = '0.03';
   
   DfmFileExt     = '.dfm';  {Delphi form file extension}
   LfmFileExt     = '.lfm';  {Lazarus form file extension}
@@ -60,6 +60,7 @@ var
   MatchFound  : TFilenameCaseMatch;
 {$ENDIF}
   FontSwitch  : Integer;
+  MacSwitch   : Boolean;
   CfgFileObj  : TMemIniFile;
   DfmFileName : string;
   LfmFileName : string;
@@ -87,12 +88,13 @@ begin
     begin
     WriteLn(ProgramName, ', version ', ProgramVersion,
             ' - converts a Delphi form file to a Lazarus form file.');
-    WriteLn('Usage: ', ProgramName, ' filename', DfmFileExt, ' [-p|-d]');
+    WriteLn('Usage: ', ProgramName, ' filename', DfmFileExt, ' [-p|-d][-m]');
     WriteLn('Switches:');
     WriteLn('  -p  Add parent''s font to controls with no font ',
             '(useful with Windows).');
     WriteLn('  -d  Delete font name from controls ',
             '(useful with GTK and GTK2).');
+    WriteLn('  -m  Mac prettifier.');
     WriteLn('Looks for configuration data in file ', CfgFileName); 
     Halt;
     end;
@@ -103,6 +105,7 @@ begin
     FontSwitch := UseParentFont
   else if FindCmdLineSwitch('d', ['-'], True) then
     FontSwitch := DeleteFontName;
+  MacSwitch := FindCmdLineSwitch('m', ['-'], True);
 
    {Load configuration file}
   if not FileExists(CfgFileName) then
@@ -298,6 +301,28 @@ begin
           end
 *)
   
+        else if MacSwitch and
+                (StackLevel > 1) and
+                (SameText('TButton', StackRec[StackLevel].ClassName) or
+                 SameText('TBitBtn', StackRec[StackLevel].ClassName)) and
+                SameText('Height=', Copy(StripStr, 1, 7)) and
+                (StrToInt(Copy(StripStr, 8, MaxInt)) > 22) then
+          WriteLn(LfmFileVar,
+                  Copy(InStr, 1, Succ(Pos('=', InStr))), '22')
+           {Reduce button height so it's displayed as oval on Mac}
+           
+        else if MacSwitch and
+                (StackLevel > 1) and
+                SameText('TabOrder=', Copy(StripStr, 1, 9)) and
+                CfgFileObj.ValueExists('MacNoFocus',
+                                       StackRec[StackLevel].ClassName) then
+          begin
+          WriteLn(LfmFileVar, InStr);  {No change to TabOrder property}
+          WriteLn(LfmFileVar,
+                  Copy(InStr, 1, Length(InStr)-Length(Trim(InStr))), {Spaces}
+                  'TabStop = False');  {Control can't receive focus}
+          end
+
         else  {No change to property}
           WriteLn(LfmFileVar, InStr);