[Instantobjects-cvscommit] SF.net SVN: instantobjects:[821] trunk/Source/Core

[<na...@us...>]

Revision: 821
          http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=821&view=rev
Author:   nandod
Date:     2009-08-14 07:15:58 +0000 (Fri, 14 Aug 2009)

Log Message:
-----------
* All XML output is now formatted and indented for better displaying, comparing, etc.
* D2009: Fixed transliteration problems with XML container blobs.
* Small optimization for InstantGetPropName.

Modified Paths:
--------------
    trunk/Source/Core/InstantClasses.pas
    trunk/Source/Core/InstantConsts.pas
    trunk/Source/Core/InstantPersistence.pas
    trunk/Source/Core/InstantRtti.pas

Modified: trunk/Source/Core/InstantClasses.pas
===================================================================
--- trunk/Source/Core/InstantClasses.pas	2009-08-11 17:45:41 UTC (rev 820)
+++ trunk/Source/Core/InstantClasses.pas	2009-08-14 07:15:58 UTC (rev 821)
@@ -267,6 +267,7 @@
     FStream: TStream;
     FTagStack: TStringList;
     FWriter: TAbstractWriter;
+    FCurrentIndentationSize: Integer;
     function GetCurrentTag: string;
     function GetEof: Boolean;
     function GetPosition: Integer;
@@ -278,6 +279,10 @@
     property TagStack: TStringList read GetTagStack;
     property Writer: TAbstractWriter read GetWriter;
   public
+    procedure Indent;
+    procedure Unindent;
+    procedure WriteIndentation;
+    procedure WriteLineBreak;
     constructor Create(Stream: TStream);
     destructor Destroy; override;
     procedure WriteEscapedData(const Data: string);
@@ -452,7 +457,7 @@
 implementation
 
 uses
-  TypInfo, InstantUtils, InstantRtti;
+  TypInfo, StrUtils, InstantUtils, InstantRtti;
 
 const
   ResourceHeader : packed array[0..31] of Byte = ($00,$00,$00,$00,$20,$00,$00,
@@ -1343,6 +1348,22 @@
 
 { TInstantXMLProducer }
 
+procedure TInstantXMLProducer.Indent;
+begin
+  Inc(FCurrentIndentationSize, InstantXMLIndentationSize);
+end;
+
+procedure TInstantXMLProducer.Unindent;
+begin
+  Dec(FCurrentIndentationSize, InstantXMLIndentationSize);
+  if InstantXMLIndentationSize >= 0 then
+  begin
+    WriteLineBreak;
+    WriteIndentation;
+  end;
+end;
+
+
 constructor TInstantXMLProducer.Create(Stream: TStream);
 begin
   inherited Create;
@@ -1445,10 +1466,26 @@
 
 procedure TInstantXMLProducer.WriteStartTag(const Tag: string);
 begin
+  if InstantXMLIndentationSize >= 0 then
+  begin
+    WriteLineBreak;
+    WriteIndentation;
+  end;
   WriteString(InstantBuildStartTag(Tag));
   TagStack.Add(Tag);
 end;
 
+procedure TInstantXMLProducer.WriteLineBreak;
+begin
+  WriteString(sLineBreak);
+end;
+
+procedure TInstantXMLProducer.WriteIndentation;
+begin
+  if FCurrentIndentationSize > 0 then
+    WriteString(DupeString(' ' , FCurrentIndentationSize));
+end;
+
 procedure TInstantXMLProducer.WriteString(const S: string);
 var
   U: UTF8String;
@@ -1763,6 +1800,7 @@
   PushObjectClass(FindClass(Reader.ReadStr));
   try
     Producer.WriteStartTag(ObjectClassName);
+    Producer.Indent;
     if ObjectClass.InheritsFrom(TInstantStreamable) then
       TInstantStreamableClass(ObjectClass).ConvertToText(Self)
     else if ObjectClass.InheritsFrom(TInstantCollection) then
@@ -1770,6 +1808,7 @@
     else if ObjectClass.InheritsFrom(TInstantCollectionItem) then
       TInstantCollectionItemClass(ObjectClass).ConvertToText(Self);
     Reader.ReadListEnd;
+    Producer.Unindent;
     Producer.WriteEndTag;
   finally
     PopObjectClass;
@@ -1839,6 +1878,7 @@
   end;
 
 begin
+  Producer.Indent;
   while not Reader.EndOfList do
   begin
     Producer.WriteStartTag(Reader.ReadStr);
@@ -1846,6 +1886,7 @@
     Producer.WriteEndTag;
   end;
   Reader.ReadListEnd;
+  Producer.Unindent;
 end;
 
 { TInstantToTextToBinaryConverter }

Modified: trunk/Source/Core/InstantConsts.pas
===================================================================
--- trunk/Source/Core/InstantConsts.pas	2009-08-11 17:45:41 UTC (rev 820)
+++ trunk/Source/Core/InstantConsts.pas	2009-08-14 07:15:58 UTC (rev 821)
@@ -70,12 +70,17 @@
   InstantSequenceNoFieldName = 'SequenceNo';
   InstantChildClassFieldName = 'ChildClass';
   InstantLogStatementBefore = 'Before: ';
+  InstantLogStatementSelect = 'Select: ';
+  InstantLogStatementExecute = 'Execute: ';
 
 {$IFNDEF D6+}
 const
   sLineBreak = #13#10;
 {$ENDIF}
 
+var
+  InstantXMLIndentationSize: Integer = 2;
+
 resourcestring
   SAccessError = 'Cannot access attribute %s(''%s'') as type: %s';
   SAccessorClassNotFoundFor = 'Accessor class not found for class %s ';

Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas	2009-08-11 17:45:41 UTC (rev 820)
+++ trunk/Source/Core/InstantPersistence.pas	2009-08-14 07:15:58 UTC (rev 821)
@@ -3465,7 +3465,7 @@
 
 function TInstantBlob.GetAsString: string;
 begin
-  Result := Value;
+  Result := string(Value);
 end;
 
 function TInstantBlob.GetAsVariant: Variant;
@@ -5226,7 +5226,7 @@
     Try
       XMLReferencesTag := Self.ClassName;
       InstantXMLProducer.WriteStartTag(XMLReferencesTag);
-      InstantXMLProducer.WriteEscapedData(sLineBreak);
+      InstantXMLProducer.WriteData(sLineBreak);
       for I := 0 to Pred(Count) do
       begin
         InstantXMLProducer.WriteStartTag(
@@ -5235,6 +5235,7 @@
         InstantXMLProducer.WriteEndTag;
       end;
       InstantXMLProducer.WriteEndTag;
+      InstantXMLProducer.WriteData(sLineBreak);
     Finally
       InstantXMLProducer.Free;
     End;
@@ -5641,7 +5642,9 @@
         vaIdent:
           begin
             Reader.ReadIdent;
+            Producer.Indent;
             Convert;
+            Producer.Unindent;
           end;
         vaFalse:
           begin
@@ -5666,8 +5669,10 @@
         vaCollection:
           begin
             Reader.ReadValue;
+            Producer.Indent;
              while not Reader.EndOfList do
                Convert;
+            Producer.Unindent;
              Reader.ReadListEnd;
           end;
       else

Modified: trunk/Source/Core/InstantRtti.pas
===================================================================
--- trunk/Source/Core/InstantRtti.pas	2009-08-11 17:45:41 UTC (rev 820)
+++ trunk/Source/Core/InstantRtti.pas	2009-08-14 07:15:58 UTC (rev 821)
@@ -78,7 +78,7 @@
 procedure InstantSetProperty(AObject: TObject; PropPath: string; Value: Variant);
 function InstantIsDefaultPropertyValue(Instance: TObject;
   PropInfo: PPropInfo): Boolean;
-function InstantGetPropName(PropInfo: PPropInfo): string;
+function InstantGetPropName(PropInfo: PPropInfo): string; {$IFNDEF D12+}inline;{$ENDIF}
 
 implementation