diff --git a/components/xdev_toolkit/CFHelpers.pas b/components/xdev_toolkit/CFHelpers.pas new file mode 100644 index 000000000..9edb829f9 --- /dev/null +++ b/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. diff --git a/components/xdev_toolkit/PrefsUtil.pas b/components/xdev_toolkit/PrefsUtil.pas new file mode 100644 index 000000000..18f043b71 --- /dev/null +++ b/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. diff --git a/components/xdev_toolkit/PropListUtil.pas b/components/xdev_toolkit/PropListUtil.pas new file mode 100644 index 000000000..1334abc81 --- /dev/null +++ b/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. diff --git a/components/xdev_toolkit/dfmtolfm.ini b/components/xdev_toolkit/dfmtolfm.ini index 40fbe21f4..658cc85c0 100644 --- a/components/xdev_toolkit/dfmtolfm.ini +++ b/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 + diff --git a/components/xdev_toolkit/dfmtolfm.pas b/components/xdev_toolkit/dfmtolfm.pas index b74f3f64f..7a9967dea 100644 --- a/components/xdev_toolkit/dfmtolfm.pas +++ b/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);