From c3468868ae0f612285ea87acded4d320ec873460 Mon Sep 17 00:00:00 2001 From: Thomas Tempelmann Date: Sun, 9 Aug 2015 10:22:19 +0200 Subject: [PATCH] Improves XMLDictionary (part of TTsSmartPreferences) to accept arrays of various common types instead of only arrays of Variants. --- About.rbbas | 18 +- .../TTsSmartPreferences.rbbas | 10 +- .../TT's SmartPreferences/XMLDictionary.rbbas | 205 +++++++++++------- Application/App.rbbas | 25 +++ 4 files changed, 165 insertions(+), 93 deletions(-) diff --git a/About.rbbas b/About.rbbas index b9caa03f..551acd70 100644 --- a/About.rbbas +++ b/About.rbbas @@ -65,6 +65,10 @@ Protected Module About When you make changes, add new notes above existing ones, and remember to increment the Version constant. + 187: 2015-08-09 by TT + - Improves XMLDictionary (part of TTsSmartPreferences) to accept arrays of various common types instead of only arrays of Variants. + - Makes IOKit compile with REAL Studio again + 186: 2015-06-21 by JC - Added IoKit.IdleTime which returns the user idle time in nano seconds - Added IoKit.IdleTime example, Examples/IOKitIdleTimeExampleWindow @@ -586,7 +590,7 @@ Protected Module About #tag EndNote - #tag Constant, Name = Version, Type = Double, Dynamic = False, Default = \"186", Scope = Protected + #tag Constant, Name = Version, Type = Double, Dynamic = False, Default = \"187", Scope = Protected #tag EndConstant @@ -595,34 +599,34 @@ Protected Module About Name="Index" Visible=true Group="ID" - InitialValue="2147483648" - Type="Integer" + InitialValue="-2147483648" + InheritedFrom="Object" #tag EndViewProperty #tag ViewProperty Name="Left" Visible=true Group="Position" InitialValue="0" - Type="Integer" + InheritedFrom="Object" #tag EndViewProperty #tag ViewProperty Name="Name" Visible=true Group="ID" - Type="String" + InheritedFrom="Object" #tag EndViewProperty #tag ViewProperty Name="Super" Visible=true Group="ID" - Type="String" + InheritedFrom="Object" #tag EndViewProperty #tag ViewProperty Name="Top" Visible=true Group="Position" InitialValue="0" - Type="Integer" + InheritedFrom="Object" #tag EndViewProperty #tag EndViewBehavior End Module diff --git a/Additional Modules/TT's SmartPreferences/TTsSmartPreferences.rbbas b/Additional Modules/TT's SmartPreferences/TTsSmartPreferences.rbbas index 7476bdf4..1bd75357 100644 --- a/Additional Modules/TT's SmartPreferences/TTsSmartPreferences.rbbas +++ b/Additional Modules/TT's SmartPreferences/TTsSmartPreferences.rbbas @@ -1,12 +1,12 @@ #tag Class Protected Class TTsSmartPreferences - #tag Method, Flags = &h1 - Protected Function AppSupportFolder(createIfMissing as Boolean = true) As FolderItem + #tag Method, Flags = &h0 + Shared Function AppSupportFolder(appName as String, createIfMissing as Boolean = true) As FolderItem // Return: // nil -> app folder invalid or can't be created // otherwise -> test for .Exists if createIfMissing=false was passed - if mAppName = "" then + if appName = "" then // App Name must be specified raise new RuntimeException end @@ -18,7 +18,7 @@ Protected Class TTsSmartPreferences return nil end if - f = f.Child(mAppName) + f = f.Child(appName) if not f.Exists then if not createIfMissing then @@ -183,7 +183,7 @@ Protected Class TTsSmartPreferences Private Sub syncPrefsFile() // This gets used only when mUseAppSupportFolder=true - dim f as FolderItem = AppSupportFolder(me.IsDirty) + dim f as FolderItem = AppSupportFolder(mAppName, me.IsDirty) if f = nil or not f.Exists then return f = f.Child("Preferences.plist") diff --git a/Additional Modules/TT's SmartPreferences/XMLDictionary.rbbas b/Additional Modules/TT's SmartPreferences/XMLDictionary.rbbas index df6db3ce..95c5b87f 100644 --- a/Additional Modules/TT's SmartPreferences/XMLDictionary.rbbas +++ b/Additional Modules/TT's SmartPreferences/XMLDictionary.rbbas @@ -7,8 +7,37 @@ Protected Module XMLDictionary Dictionary(storage).Clear End If ElseIf storage.IsArray Then + dim t as Integer = storage.ArrayElementType + if t = Variant.TypeString then + dim a() as String = storage + redim a(-1) + elseif t = Variant.TypeInteger then + dim a() as Integer = storage + redim a(-1) + elseif t = Variant.TypeBoolean then + dim a() as Boolean = storage + redim a(-1) + elseif t = Variant.TypeDouble then + dim a() as Double = storage + redim a(-1) + elseif t = Variant.TypeSingle then + dim a() as Single = storage + redim a(-1) + elseif t = Variant.TypeDate then + dim a() as Date = storage + redim a(-1) + elseif t = Variant.TypeLong then + dim a() as Int64 = storage + redim a(-1) + elseif t = Variant.TypeObject then + dim a() as Object = storage + redim a(-1) + end + + // fallback for unknown types - if this gets a TypeMismatchException, add the missing type to another elseif/dim/return above dim a() as Variant = storage redim a(-1) + End If End Sub #tag EndMethod @@ -450,8 +479,37 @@ Protected Module XMLDictionary Return Dictionary(storage.ObjectValue).Count End If ElseIf storage.IsArray Then + dim t as Integer = storage.ArrayElementType + if t = Variant.TypeString then + dim a() as String = storage + return a.Ubound+1 + elseif t = Variant.TypeInteger then + dim a() as Integer = storage + return a.Ubound+1 + elseif t = Variant.TypeBoolean then + dim a() as Boolean = storage + return a.Ubound+1 + elseif t = Variant.TypeDouble then + dim a() as Double = storage + return a.Ubound+1 + elseif t = Variant.TypeSingle then + dim a() as Single = storage + return a.Ubound+1 + elseif t = Variant.TypeDate then + dim a() as Date = storage + return a.Ubound+1 + elseif t = Variant.TypeLong then + dim a() as Int64 = storage + return a.Ubound+1 + elseif t = Variant.TypeObject then + dim a() as Object = storage + return a.Ubound+1 + end + + // fallback for unknown types - if this gets a TypeMismatchException, add the missing type to another elseif/dim/return above dim a() as Variant = storage return a.Ubound+1 + End If End Function #tag EndMethod @@ -473,8 +531,37 @@ Protected Module XMLDictionary Return Dictionary(storage.ObjectValue).Value(key) End If ElseIf storage.IsArray Then + dim t as Integer = storage.ArrayElementType + if t = Variant.TypeString then + dim a() as String = storage + return a(index) + elseif t = Variant.TypeInteger then + dim a() as Integer = storage + return a(index) + elseif t = Variant.TypeBoolean then + dim a() as Boolean = storage + return a(index) + elseif t = Variant.TypeDouble then + dim a() as Double = storage + return a(index) + elseif t = Variant.TypeSingle then + dim a() as Single = storage + return a(index) + elseif t = Variant.TypeDate then + dim a() as Date = storage + return a(index) + elseif t = Variant.TypeLong then + dim a() as Int64 = storage + return a(index) + elseif t = Variant.TypeObject then + dim a() as Object = storage + return a(index) + end + + // fallback for unknown types - if this gets a TypeMismatchException, add the missing type to another elseif/dim/return above dim a() as Variant = storage return a(index) + End If End Function #tag EndMethod @@ -482,8 +569,45 @@ Protected Module XMLDictionary #tag Method, Flags = &h21 Private Sub StoreValue(key As Variant, value As Variant, storage As Variant) If storage.IsArray Then + dim t as Integer = storage.ArrayElementType + if t = Variant.TypeString then + dim a() as String = storage + a.Append value + return + elseif t = Variant.TypeInteger then + dim a() as Integer = storage + a.Append value + return + elseif t = Variant.TypeBoolean then + dim a() as Boolean = storage + a.Append value + return + elseif t = Variant.TypeDouble then + dim a() as Double = storage + a.Append value + return + elseif t = Variant.TypeSingle then + dim a() as Single = storage + a.Append value + return + elseif t = Variant.TypeDate then + dim a() as Date = storage + a.Append value + return + elseif t = Variant.TypeLong then + dim a() as Int64 = storage + a.Append value + return + elseif t = Variant.TypeObject then + dim a() as Object = storage + a.Append value + return + end + + // fallback for unknown types - if this gets a TypeMismatchException, add the missing type to another elseif/dim/Append/return above dim a() as Variant = storage a.Append value + ElseIf storage.Type = 9 Then If storage.ObjectValue IsA Dictionary And key <> nil Then Dictionary(storage.ObjectValue).Value(key) = value @@ -492,87 +616,6 @@ Protected Module XMLDictionary End Sub #tag EndMethod - #tag Method, Flags = &h21 - Private Function VariantValueAsString(v As Variant) As String - // Added by Kem Tekinay. - // Gets the true value of a double/single as a string. - // Can't use str without truncating and can't use format without truncating or adding junk. - - dim isDouble as boolean - select case v.Type - case Variant.TypeDouble - isDouble = true - case Variant.TypeSingle - // isDouble = false - else // Not a single or double - if v.Type = Variant.TypeObject then - return "" - else - return v.StringValue - end if - end select - - return v.StringValue - - // The code below is an exercise in making the value of a double "pretty", i.e., keep it - // from returning scientific notation. After much experimentation, we found that - // these attempts can lose precision in some cases so it was safer to use StringValue. - // In the end, this method isn't being used anywhere, but has been left here - // for later examination. - - 'const kBunchOfHash = "####################################################################################" - ' - 'dim dv as double = v.DoubleValue - 'dim sv as single = v.SingleValue - 'dim s as string = v.StringValue - 'dim parts() as string = s.SplitB( "e" ) - 'if parts.Ubound = 0 then return s // Not scientific notation - ' - 'dim valAsStr as string - 'if isDouble then - 'valAsStr = str( dv ) - 'else - 'valAsStr = str( sv ) - 'end if - ' - 'dim numStr as string = parts( 0 ) - 'dim decimalPlaces as integer = val( parts( 1 ) ) - 'dim numParts() as string = numStr.SplitB( "." ) // Get the decimal part - 'if numParts.Ubound = 1 then decimalPlaces = decimalPlaces - len( numParts( 1 ) ) // Complete decimal places - ' - 'if decimalPlaces < -20 or decimalPlaces > 20 then return valAsStr // Really large or really small number - ' - 'if decimalPlaces > 0 then - 'dim formatStr as string = kBunchOfHash.Left( decimalPlaces ) + ".########" - 'if dv < 0. then formatStr = "-" + formatStr - 'return str( dv, formatStr ) - ' - 'else - ' - 'decimalPlaces = 0 - decimalPlaces // Make it positive - 'if decimalPlaces > 19 then - 'return s - 'else - 'dim formatStr as string = "0." + kBunchOfHash.Left( decimalPlaces ) - 'if dv < 0. then formatStr = "-" + formatStr - 'dim r as string = str( dv, formatStr ) - ' - '// This is a bit of a hack to compensate for rounding errors - 'if decimalPlaces = 17 then - 'if valAsStr.InStrB( "e" ) = 0 then // str does not give us scientific notation so it's possible to use it - 'dim lastSix as string = r.RightB( 6 ) - 'if StrComp( lastSix, "000001", 0 ) = 0 or StrComp( lastSix, "999999", 0) = 0 then r = valAsStr - 'end if - 'end if - ' - 'return r - 'end if - ' - 'end if - - End Function - #tag EndMethod - #tag Note, Name = About This is now part of the open source "MacOSLib" diff --git a/Application/App.rbbas b/Application/App.rbbas index 0147f5a6..9b36baf8 100644 --- a/Application/App.rbbas +++ b/Application/App.rbbas @@ -12,6 +12,7 @@ Inherits Application TestCertTools TestFileManager TestBundleLookup + TestTTsSmartPrefs End Sub #tag EndEvent @@ -1107,6 +1108,30 @@ Inherits Application End Sub #tag EndMethod + #tag Method, Flags = &h1 + Protected Sub TestTTsSmartPrefs() + const appName = "MacOSLib Prefs Testing" + try + // create a new prefs file + Dim prefs As New TTsSmartPreferences(appName, true) + Dim currentArray() As Variant + currentArray = prefs.Value("somearray", currentArray) // when retrieving arrays, an array of Variants must be used + prefs.Value("somearray") = Array("foo", "bar") // when setting arrays, arrays of String, Integer, Boolean, Double etc. may be used + prefs.Sync ' writes the data to the prefs file immediately + prefs = nil + // re-read the data using a fresh class + prefs = New TTsSmartPreferences(appName, true) + Dim updatedArray() As Variant + updatedArray = prefs.Value("somearray", updatedArray) + catch + 'ignore + end + // delete the prefs file and folder + TTsSmartPreferences.AppSupportFolder(appName, false).Child("Preferences.plist").Delete + TTsSmartPreferences.AppSupportFolder(appName, false).Delete + End Sub + #tag EndMethod + #tag ComputedProperty, Flags = &h0 #tag Getter