View Issue Details

IDProjectCategoryView StatusLast Update
0016742LazarusLCLpublic2011-01-26 02:22
Reportercobines Assigned ToMattias Gaertner  
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
PlatformLinuxOSDebian 
Product Version0.9.29 (SVN) 
Target Version0.9.30 
Summary0016742: Collections items don't have unique identifiers in LRT file
DescriptionIf a control has collections as published properties then collections items do not have unique identifiers in LRT file, and so they cannot be properly localized.

For example Columns property of TStringGrid in LFM:

    Columns = <
      item
        Title.Caption = 'First'
      end
      item
        Title.Caption = 'Second'
      end
      item
        Title.Caption = 'Third'
      end>

In the generated LRT file each title has the same identifier (this is pre SVN 25431):

TFORM1.STRINGGRID1.COLUMNS.TITLE.CAPTION=First
TFORM1.STRINGGRID1.COLUMNS.TITLE.CAPTION=Second
TFORM1.STRINGGRID1.COLUMNS.TITLE.CAPTION=Third


This issue is a more general variant of issue 0015180. There were two patches proposed there, the second one was applied to SVN in rev. 25431 which works fine for TStringGrid, but I don't think it is satisfactory in general case.


I have attached example which doesn't work (included run and design time package with custom control). The produced LRT must have a unique path for each value and it doesn't.

For example in LFM we have control with collection having two items:

  object ExamCtrl1: TExamCtrl
    Col1 = <
      item
        Title = 'Random value 210'
        Inner.Title = 'Random value 827'
      end
      item
        Title = 'Random value 827'
        Inner.Title = 'Random value 1207'
      end>
  end

With SVN < 25431 the LRT is:

    TFORM1.EXAMCTRL1.COL1.TITLE=Random value 210
    TFORM1.EXAMCTRL1.COL1.INNER.TITLE=Random value 827
    TFORM1.EXAMCTRL1.COL1.TITLE=Random value 827
    TFORM1.EXAMCTRL1.COL1.INNER.TITLE=Random value 1207


With SVN >= 25431 the LRT is:

    TFORM1.EXAMCTRL1.COL1[0].TITLE=Random value 210
    TFORM1.TMYCOLLECTION[0].TITLE=Random value 827
    TFORM1.EXAMCTRL1.COL1[1].TITLE=Random value 827
    TFORM1.TMYCOLLECTION[0].TITLE=Random value 1207

Here, TMYCOLLECTION is outputted by GetNamePath, because the Inner collection has a collection item as an owner and the Inner collection is not available as a property from this collection item. Hence this not a good solution I think, because it needs TPersistent to be directly available as a property from its Owner.


Desired LRT would be something like this:

    TFORM1.EXAMCTRL1.COL1[0].TITLE=Random value 210
    TFORM1.EXAMCTRL1.COL1[0].INNER.TITLE=Random value 827
    TFORM1.EXAMCTRL1.COL1[1].TITLE=Random value 827
    TFORM1.EXAMCTRL1.COL1[1].INNER.TITLE=Random value 1207

  or

    TFORM1.EXAMCTRL1.COL1.ITEM0.TITLE=Random value 210
    TFORM1.EXAMCTRL1.COL1.ITEM0.INNER.TITLE=Random value 827
    TFORM1.EXAMCTRL1.COL1.ITEM1.TITLE=Random value 827
    TFORM1.EXAMCTRL1.COL1.ITEM1.INNER.TITLE=Random value 1207

Each Item should produce a unique identifier.


With SVN < 25431 the code that writes LRT is using cached nodes names from LRS writer to create identifiers, but LRS writer does not number the collections items. The 'Title' and 'Inner.Title' are simply written one after another:

   'TExamCtrl'0000009
  +'ExamCtrl1'0000004'Left'0000002#24#6'Height'0000002'j'0000003'Top'0000002#16#5'Width'0000003#184#0#4'Col1'
  +0000014#1#5'Title'0000006#16'Random value 210'0000011'Inner.Title'0000006#16'Random value 827'
  +#0#1#5'Title'0000006#16'Random value 827'0000011'Inner.Title'0000006#17'Random value 1207'
  +#0#0#4'Col2'0000014#1#5'Title'0000006#16'Random value 805'0000011'Inner.Title'0000006#16'Rando'
  +'m value 822'#0#1#5'Title'0000006#16'Random value 822'0000011'Inner.Title'0000006#16'Rando'
  +'m value 569'#0#0#0#0

In LRT there must be a unique part inserted between 'Col1' and 'Title', and between 'Col1' and 'Inner Title'.
Tagsmerge to 0.9.30
Fixed in Revision29201
LazTarget0.9.30
Widgetset
Attached Files

Relationships

related to 0015180 closedMaxim Ganetsky Only the last column title of a grid can be localized via .lrt/.po 

Activities

2010-06-16 19:54

 

cobines

2010-12-16 00:50

reporter   ~0044257

I have made changes that allow counters to be emitted for collections. The LRSWriter uses a stack to track objects names, I added a counter there. I have implemented analogous stack in LRSReader, so that stack paths when reading/writing components are exactly the same. The changes are attached in "lrt_collections.diff".

I have attached an application in "lrt_translation_test.tar.bz2" that contains some controls to test which properties can be translated. To test it you have to open the project in Lazarus, move the form in "main" unit and save it, so that LRT file is regenerated. Then rebuild the project so that PO is generated.
There are three directories in the archive: "r25430", "r25431" and "lrt_diff". They each contain PO and LRT files; first two were generated by the according Lazarus revisions, and the last one was generated with the patch "lrt_collections.diff". Output of "diff3" of those three LRT files is attached as "main.lrt.diff3".
The sample translated PO file (example2.pl.po) has every translated string beginning with [T], so you can easily see which strings were translated when running the application.


Some properties were not translatable before, so they don't work with the patch either:

- TStrings is a custom serialized property. Controls affected:
  TMemo, TListBox, TRadioGroup, TCheckGroup, TCheckListBox, TComboBox

- properties of type "string" instead of TTranslateString: TEditButton.Text, TStatusBar.SimpleText, TStatusPanel.Text, THeaderSection.Text


I changed the way LRT paths are generated and incidently it also fixed issue with frames (or other inline components). Currently components in TFrame are saved using class name, so if there are two instances of the same frame they have the same path in the LRT file:

TFRAME1.LABELEDEDIT1.EDITLABEL.CAPTION=Frame1_1LabeledEdit1Label
TFRAME1.LABELEDEDIT1.TEXT=Frame1_1LabeledEdit1
TFRAME1.LABELEDEDIT1.EDITLABEL.CAPTION=Frame1_2LabeledEdit1Label
TFRAME1.LABELEDEDIT1.TEXT=Frame1_2LabeledEdit1

With the patch it is:

TFORM1.FRAME1_1.LABELEDEDIT1.EDITLABEL.CAPTION=Frame1_1LabeledEdit1Label
TFORM1.FRAME1_1.LABELEDEDIT1.TEXT=Frame1_1LabeledEdit1
TFORM1.FRAME1_2.LABELEDEDIT1.EDITLABEL.CAPTION=Frame1_2LabeledEdit1Label
TFORM1.FRAME1_2.LABELEDEDIT1.TEXT=Frame1_2LabeledEdit1

----

Some differences in generated LRT between r25430 and "lrt_collections.diff". Full diff between 3 LRT files attached as "main.lrt.diff3".

----
r25430:

  TFORM1.EXAMCTRL1.COL1.TITLE=Random value 394
  TFORM1.EXAMCTRL1.COL1.INNER.TITLE=Random value 0
  TFORM1.EXAMCTRL1.COL1.TITLE=Random value 572
  TFORM1.EXAMCTRL1.COL1.INNER.TITLE=Random value 604
  TFORM1.EXAMCTRL1.COL2.TITLE=Random value 1007
  TFORM1.EXAMCTRL1.COL2.INNER.TITLE=Random value 1177
  TFORM1.EXAMCTRL1.COL2.TITLE=Random value 844
  TFORM1.EXAMCTRL1.COL2.INNER.TITLE=Random value 325
  TFORM1.EXAMCTRL1.SUBCOMP.CAPTION=SubLabel text

  TFORM1.STRINGGRID1.COLUMNS.TITLE.CAPTION=First
  TFORM1.STRINGGRID1.COLUMNS.TITLE.CAPTION=Second
  TFORM1.STRINGGRID1.COLUMNS.TITLE.CAPTION=Third

  TFRAME1.LABELEDEDIT1.EDITLABEL.CAPTION=Frame1_1LabeledEdit1Label
  TFRAME1.LABELEDEDIT1.TEXT=Frame1_1LabeledEdit1
  TFRAME1.LABELEDEDIT1.EDITLABEL.CAPTION=Frame1_2LabeledEdit1Label
  TFRAME1.LABELEDEDIT1.TEXT=Frame1_2LabeledEdit1

----
lrt_collections.diff

  TFORM1.EXAMCTRL1.COL1[0].TITLE=Random value 394
  TFORM1.EXAMCTRL1.COL1[0].INNER.TITLE=Random value 0
  TFORM1.EXAMCTRL1.COL1[1].TITLE=Random value 572
  TFORM1.EXAMCTRL1.COL1[1].INNER.TITLE=Random value 604
  TFORM1.EXAMCTRL1.COL2[0].TITLE=Random value 1007
  TFORM1.EXAMCTRL1.COL2[0].INNER.TITLE=Random value 1177
  TFORM1.EXAMCTRL1.COL2[1].TITLE=Random value 844
  TFORM1.EXAMCTRL1.COL2[1].INNER.TITLE=Random value 325
  TFORM1.EXAMCTRL1.SUBCOMP.CAPTION=SubLabel text

  TFORM1.STRINGGRID1.COLUMNS[0].TITLE.CAPTION=First
  TFORM1.STRINGGRID1.COLUMNS[1].TITLE.CAPTION=Second
  TFORM1.STRINGGRID1.COLUMNS[2].TITLE.CAPTION=Third

  TFORM1.FRAME1_1.LABELEDEDIT1.EDITLABEL.CAPTION=Frame1_1LabeledEdit1Label
  TFORM1.FRAME1_1.LABELEDEDIT1.TEXT=Frame1_1LabeledEdit1
  TFORM1.FRAME1_2.LABELEDEDIT1.EDITLABEL.CAPTION=Frame1_2LabeledEdit1Label
  TFORM1.FRAME1_2.LABELEDEDIT1.TEXT=Frame1_2LabeledEdit1

2010-12-16 00:51

 

lrt_collections.diff (20,140 bytes)   
Index: ide/main.pp
===================================================================
--- ide/main.pp	(wersja 28724)
+++ ide/main.pp	(kopia robocza)
@@ -5277,16 +5277,14 @@
   PropInfo: PPropInfo; var Content: string);
 var
   LRSWriter: TLRSObjectWriter;
-  Path, WriterRootPath: String;
+  Path: String;
 begin
   if not Assigned(Instance) then exit;
   if not Assigned(PropInfo) then exit;
   if SysUtils.CompareText(PropInfo^.PropType^.Name,'TTRANSLATESTRING')<>0 then exit;
-  Path:='';
   if Writer.Driver is TLRSObjectWriter then begin
     LRSWriter:=TLRSObjectWriter(Writer.Driver);
-    WriterRootPath:=LRSWriter.GetStackPath(Writer.Root);
-    Path:=Copy(WriterRootPath, 1, Pos('.',WriterRootPath))+Instance.GetNamePath+'.'+PropInfo^.Name;
+    Path:=LRSWriter.GetStackPath;
   end else begin
     Path:=Instance.ClassName+'.'+PropInfo^.Name;
   end;
@@ -5398,7 +5396,7 @@
           on E: Exception do begin
             PropPath:='';
             if Writer.Driver is TLRSObjectWriter then
-              PropPath:=TLRSObjectWriter(Writer.Driver).GetStackPath(AnUnitInfo.Component);
+              PropPath:=TLRSObjectWriter(Writer.Driver).GetStackPath;
             DumpExceptionBackTrace;
             ACaption:=lisStreamingError;
             AText:=Format(lisUnableToStreamT, [AnUnitInfo.ComponentName,
Index: lcl/defaulttranslator.pas
===================================================================
--- lcl/defaulttranslator.pas	(wersja 28724)
+++ lcl/defaulttranslator.pas	(kopia robocza)
@@ -201,7 +201,41 @@
   Result := '';
 end;
 
+function GetIdentifierPath(Sender: TObject;
+                           const Instance: TPersistent;
+                           PropInfo: PPropInfo): string;
 var
+  Tmp: TPersistent;
+  Component: TComponent;
+  Reader: TReader;
+begin
+  Result := '';
+  if (PropInfo = nil) or
+     (SysUtils.CompareText(PropInfo^.PropType^.Name, 'TTRANSLATESTRING') <> 0) then
+    exit;
+
+  // do not translate at design time
+  // get the component
+  Tmp := Instance;
+  while Assigned(Tmp) and not (Tmp is TComponent) do
+    Tmp := TPersistentAccess(Tmp).GetOwner;
+  if not Assigned(Tmp) then
+    exit;
+  Component := Tmp as TComponent;
+  if (csDesigning in Component.ComponentState) then
+    exit;
+
+  if not (Sender is TReader) then
+    exit;
+  Reader := TReader(Sender);
+  if Reader.Driver is TLRSObjectReader then
+    Result := TLRSObjectReader(Reader.Driver).GetStackPath
+  else
+    Result := Instance.ClassName + '.' + PropInfo^.Name;
+  Result := UpperCase(Result);
+end;
+
+var
   lcfn: string;
 
 { TDefaultTranslator }
@@ -225,44 +259,21 @@
   const Instance: TPersistent; PropInfo: PPropInfo; var Content: string);
 var
   s: string;
-  Section: string;
-  Tmp: TPersistent;
-  Component: TComponent;
 begin
-  if not Assigned(FMOFile) then
-    exit;
-  if not Assigned(PropInfo) then
-    exit;
-  if (UpperCase(PropInfo^.PropType^.Name) <> 'TTRANSLATESTRING') then
-    exit;
-  // do not translate at design time
-  // get the component
-  Tmp := Instance;
-  while Assigned(Tmp) and not (Tmp is TComponent) do
-    Tmp := TPersistentAccess(Tmp).GetOwner;
-  if not Assigned(Tmp) then
-    exit;
-  Component := Tmp as TComponent;
-  if (csDesigning in Component.ComponentState) then
-    exit;
+  if Assigned(FMOFile) then
+  begin
+    s := GetIdentifierPath(Sender, Instance, PropInfo);
+    if s <> '' then
+    begin
+      s := FMoFile.Translate(s + #4 + Content);
 
-  if not (Sender is TReader) then
-    exit;
-  if Component = TReader(Sender).Root then
-    Section := Component.ClassName
-  else
-    if Component.Owner = TReader(Sender).Root then
-      Section := Component.Owner.ClassName
-    else
-      exit;
-  Section := UpperCase(Section + '.' + Instance.GetNamePath + '.' + PropInfo^.Name);
-  s := FMoFile.Translate(Section + #4 + Content);
+      if s = '' then
+        s := FMOFile.Translate(Content);
 
-  if s = '' then
-    s := FMOFile.Translate(Content);
-
-  if s <> '' then
-    Content := s;
+      if s <> '' then
+        Content := s;
+    end;
+  end;
 end;
 
 { TPOTranslator }
@@ -286,41 +297,18 @@
   const Instance: TPersistent; PropInfo: PPropInfo; var Content: string);
 var
   s: string;
-  Section: string;
-  Tmp: TPersistent;
-  Component: TComponent;
 begin
-  if not Assigned(FPOFile) then
-    exit;
-  if not Assigned(PropInfo) then
-    exit;
-  if (UpperCase(PropInfo^.PropType^.Name) <> 'TTRANSLATESTRING') then
-    exit;
-  // do not translate at design time
-  // get the component
-  Tmp := Instance;
-  while Assigned(Tmp) and not (Tmp is TComponent) do
-    Tmp := TPersistentAccess(Tmp).GetOwner;
-  if not Assigned(Tmp) then
-    exit;
-  Component := Tmp as TComponent;
-  if (csDesigning in Component.ComponentState) then
-    exit;
+  if Assigned(FPOFile) then
+  begin
+    s := GetIdentifierPath(Sender, Instance, PropInfo);
+    if s <> '' then
+    begin
+      s := FPOFile.Translate(s, Content);
 
-  if not (Sender is TReader) then
-    exit;
-  if Component = TReader(Sender).Root then
-    Section := Component.ClassName
-    else
-      if Component.Owner = TReader(Sender).Root then
-        Section := Component.Owner.ClassName
-      else
-        exit;
-  Section := UpperCase(Section + '.' + Instance.GetNamePath + '.' + PropInfo^.Name);
-  s := FPOFile.Translate(Section, Content);
-
-  if s <> '' then
-    Content := s;
+      if s <> '' then
+        Content := s;
+    end;
+  end;
 end;
 
 var
Index: lcl/lresources.pp
===================================================================
--- lcl/lresources.pp	(wersja 28724)
+++ lcl/lresources.pp	(kopia robocza)
@@ -112,7 +112,24 @@
 
 
 var LRSTranslator: TAbstractTranslator;
+
 type
+  TLRSItemType = (
+    lrsitCollection,
+    lrsitComponent,
+    lrsitList,
+    lrsitProperty
+  );
+
+  TLRSORStackItem = record
+    Name: string;
+    ItemType: TLRSItemType;
+    Root: TComponent;
+    PushCount: integer; // waiting for this number of Pop
+    ItemNr: integer; // nr in a collection or list
+  end;
+  PLRSORStackItem = ^TLRSORStackItem;
+
   { TLRSObjectReader }
 
   TLRSObjectReader = class(TAbstractObjectReader)
@@ -122,8 +139,18 @@
     FBufSize: Integer;
     FBufPos: Integer;
     FBufEnd: Integer;
+    FStack: PLRSORStackItem;
+    FStackPointer: integer;
+    FStackCapacity: integer;
+    FReader: TReader;
     procedure SkipProperty;
     procedure SkipSetBody;
+    procedure Push(ItemType: TLRSItemType; const AName: string = '';
+                   Root: TComponent = nil; PushCount: integer = 1);
+    procedure Pop;
+    procedure ClearStack;
+    function InternalReadValue: TValueType;
+    procedure EndPropertyIfOpen;
   protected
     function ReadIntegerContent: integer;
   public
@@ -136,6 +163,7 @@
     procedure BeginComponent(var Flags: TFilerFlags; var AChildPos: Integer;
       var CompClassName, CompName: String); override;
     function BeginProperty: String; override;
+    function GetStackPath: string;
 
     procedure Read(var Buf; Count: LongInt); override;
     procedure ReadBinary(const DestData: TMemoryStream); override;
@@ -159,6 +187,7 @@
     procedure SkipValue; override;
   public
     property Stream: TStream read FStream;
+    property Reader: TReader read FReader write FReader;
   end;
   TLRSObjectReaderClass = class of TLRSObjectReader;
 
@@ -188,8 +217,10 @@
 
   TLRSOWStackItem = record
     Name: string;
-    Instance: TPersistent;
+    ItemType: TLRSItemType;
+    Root: TComponent;
     PushCount: integer; // waiting for this number of Pop
+    ItemNr: integer; // nr in a collection or list
     SkipIfEmpty: boolean;
     State: TLRSOWStackItemState;
     Buffer: Pointer;
@@ -211,9 +242,10 @@
     FStackPointer: integer;
     FStackCapacity: integer;
     FWriteEmptyInheritedChilds: boolean;
-    function GetInstanceStack(Index: integer): TPersistent;
-    procedure Push(const AName: string = ''; Instance: TPersistent = nil;
-                   PushCount: integer = 1; SkipIfEmpty: boolean = false);
+    FWriter: TWriter;
+    procedure Push(ItemType: TLRSItemType; const AName: string = '';
+                   Root: TComponent = nil; PushCount: integer = 1;
+                   SkipIfEmpty: boolean = false);
     procedure EndHeader;
     procedure Pop(WriteNull: boolean);
     procedure ClearStack;
@@ -248,7 +280,7 @@
     procedure EndList; override;
     procedure BeginProperty(const PropName: String); override;
     procedure EndProperty; override;
-    function GetStackPath(Root: TComponent): string;
+    function GetStackPath: string;
 
     procedure Write(const Buffer; Count: Longint); override;
     procedure WriteBinary(const Buffer; Count: LongInt); override;
@@ -267,12 +299,11 @@
     procedure WriteUnicodeString(const Value: UnicodeString); override;
     {$endif}
 
-    property InstanceStackPointer: integer read FStackPointer;
-    property InstanceStack[Index: integer]: TPersistent read GetInstanceStack;
     property WriteEmptyInheritedChilds: boolean read FWriteEmptyInheritedChilds write FWriteEmptyInheritedChilds;
+    property Writer: TWriter read FWriter write FWriter;
   end;
   TLRSObjectWriterClass = class of TLRSObjectWriter;
-  
+
   TLRPositionLink = record
     LFMPosition: int64;
     LRSPosition: int64;
@@ -3105,13 +3136,18 @@
   Result.OnPropertyNotFound := @(PropertiesToSkip.DoPropertyNotFound);
 
   DestroyDriver:=false;
-  if Result.Driver.ClassType=LRSObjectReaderClass then exit;
+  if Result.Driver.ClassType=LRSObjectReaderClass then
+  begin
+    TLRSObjectReader(Result.Driver).Reader:=Result;
+    exit;
+  end;
   // hack to set a write protected variable.
   // DestroyDriver:=true; TReader will free it
   Driver:=LRSObjectReaderClass.Create(s,4096);
   p:=@Result.Driver;
   Result.Driver.Free;
   TAbstractObjectReader(p^):=Driver;
+  TLRSObjectReader(Driver).Reader:=Result;
 end;
 
 function CreateLRSWriter(s: TStream; var DestroyDriver: boolean): TWriter;
@@ -3121,6 +3157,7 @@
   Driver:=LRSObjectWriterClass.Create(s,4096);
   DestroyDriver:=true;
   Result:=TWriter.Create(Driver);
+  TLRSObjectWriter(Driver).Writer:=Result;
 end;
 
 { LRS format converter functions }
@@ -3770,6 +3807,61 @@
   while Length(ReadStr) > 0 do;
 end;
 
+procedure TLRSObjectReader.Push(ItemType: TLRSItemType; const AName: string;
+                                Root: TComponent; PushCount: integer);
+begin
+  if FStackPointer=FStackCapacity then begin
+    FStackCapacity:=FStackCapacity*2+10;
+    ReAllocMem(FStack,SizeOf(TLRSORStackItem)*FStackCapacity);
+    FillByte(FStack[FStackPointer],SizeOf(TLRSORStackItem)*(FStackCapacity-FStackPointer),0);
+  end;
+  //DebugLn(['TLRSObjectReader.Push AName=',AName,' Type=', GetEnumName(TypeInfo(TLRSItemType), Integer(ItemType)),' PushCount=',PushCount]);
+  FStack[FStackPointer].Name:=AName;
+  FStack[FStackPointer].ItemType:=ItemType;
+  FStack[FStackPointer].Root:=Root;
+  FStack[FStackPointer].PushCount:=PushCount;
+  FStack[FStackPointer].ItemNr:=-1;
+  inc(FStackPointer);
+end;
+
+procedure TLRSObjectReader.Pop;
+var
+  Item: PLRSORStackItem;
+begin
+  if FStackPointer=0 then
+    raise Exception.Create('Error: TLRSObjectReader.Pop stack is empty');
+  Item:=@FStack[FStackPointer-1];
+  //DebugLn(['TLRSObjectReader.Pop AName=',Item^.Name,
+  //        ' Type=',GetEnumName(TypeInfo(TLRSItemType), Integer(item^.ItemType)),
+  //        ' PushCount=',item^.PushCount,' StackPtr=', FStackPointer]);
+  if Item^.PushCount>1 then begin
+    // stack item still needs more EndList
+    dec(Item^.PushCount);
+  end else begin
+    // stack item is complete
+    dec(FStackPointer);
+  end;
+end;
+
+procedure TLRSObjectReader.ClearStack;
+var
+  i: Integer;
+begin
+  for i:=0 to FStackCapacity-1 do begin
+    FStack[i].Name:='';
+  end;
+  ReAllocMem(FStack,0);
+end;
+
+function TLRSObjectReader.InternalReadValue: TValueType;
+var
+  b: byte;
+begin
+  Result := vaNull; { Necessary in FPC as TValueType is larger than 1 byte! }
+  Read(b,1);
+  Result:=TValueType(b);
+end;
+
 function TLRSObjectReader.ReadIntegerContent: integer;
 begin
   Result:=0;
@@ -3796,21 +3888,39 @@
   if Assigned(FBuffer) then
     FreeMem(FBuffer, FBufSize);
 
+  ClearStack;
+
   inherited Destroy;
 end;
 
 function TLRSObjectReader.ReadValue: TValueType;
-var
-  b: byte;
 begin
-  Result := vaNull; { Necessary in FPC as TValueType is larger than 1 byte! }
-  Read(b,1);
-  Result:=TValueType(b);
+  Result := InternalReadValue;
+  case Result of
+    vaNull:
+      begin
+        EndPropertyIfOpen;
+        // End previous element collection, list or component.
+        if FStackPointer > 0 then
+          Pop;
+      end;
+    vaCollection:
+      begin
+        Push(lrsitCollection);
+      end;
+    vaList:
+      begin
+        // Increase counter for next collection item.
+        if (FStackPointer > 0) and (FStack[FStackPointer-1].ItemType = lrsitCollection) then
+          Inc(FStack[FStackPointer-1].ItemNr);
+        Push(lrsitList);
+      end;
+  end;
 end;
 
 function TLRSObjectReader.NextValue: TValueType;
 begin
-  Result := ReadValue;
+  Result := InternalReadValue;
   { We only 'peek' at the next value, so seek back to unget the read value: }
   Dec(FBufPos);
 end;
@@ -3831,6 +3941,8 @@
 var
   Prefix: Byte;
   ValueType: TValueType;
+  ItemName: String;
+  ItemRoot: TComponent;
 begin
   { Every component can start with a special prefix: }
   Flags := [];
@@ -3860,13 +3972,73 @@
 
   CompClassName := ReadStr;
   CompName := ReadStr;
+
+  // Top component is addressed by ClassName.
+  if FStackPointer = 0 then
+  begin
+    ItemName := CompClassName;
+    ItemRoot := nil;
+  end
+  else
+  begin
+    ItemName := CompName;
+    if Assigned(Reader) then
+      // Reader.LookupRoot is the current Root component.
+      ItemRoot := Reader.LookupRoot
+    else
+      ItemRoot := nil;
+  end;
+
+  // A component has two lists: properties and childs, hence PopCount=2.
+  Push(lrsitComponent, ItemName, ItemRoot, 2);
 end;
 
 function TLRSObjectReader.BeginProperty: String;
 begin
+  EndPropertyIfOpen;
   Result := ReadStr;
+  Push(lrsitProperty, Result);
 end;
 
+procedure TLRSObjectReader.EndPropertyIfOpen;
+begin
+  // End previous property.
+  if (FStackPointer > 0) and (FStack[FStackPointer-1].ItemType = lrsitProperty) then
+    Pop;
+end;
+
+function TLRSObjectReader.GetStackPath: string;
+var
+  i: Integer;
+  CurName: string;
+  Item: PLRSORStackItem;
+begin
+  Result:='';
+
+  for i:=0 to FStackPointer-1 do
+  begin
+    Item := @FStack[i];
+
+    // Reader.Root is the top component in the module.
+    if Assigned(Reader) and
+       (Item^.ItemType = lrsitComponent) and
+       (Item^.Root = Reader.Root) and
+       (Item^.Root <> nil) then
+    begin
+      // Restart path from top component.
+      Result := Item^.Root.ClassName;
+    end;
+
+    CurName:=Item^.Name;
+    if CurName<>'' then begin
+      if Result<>'' then Result:=Result+'.';
+      Result:=Result+CurName;
+    end;
+    if Item^.ItemNr >= 0 then
+      Result := Result + '[' + IntToStr(Item^.ItemNr) + ']';
+  end;
+end;
+
 procedure TLRSObjectReader.ReadBinary(const DestData: TMemoryStream);
 var
   BinSize: LongInt;
@@ -4160,23 +4332,21 @@
 
 { TLRSObjectWriter }
 
-function TLRSObjectWriter.GetInstanceStack(Index: integer): TPersistent;
+procedure TLRSObjectWriter.Push(ItemType: TLRSItemType; const AName: string;
+                                Root: TComponent; PushCount: integer;
+                                SkipIfEmpty: boolean);
 begin
-  Result:=FStack[Index].Instance;
-end;
-
-procedure TLRSObjectWriter.Push(const AName: string; Instance: TPersistent;
-  PushCount: integer; SkipIfEmpty: boolean);
-begin
   if FStackPointer=FStackCapacity then begin
     FStackCapacity:=FStackCapacity*2+10;
     ReAllocMem(FStack,SizeOf(TLRSOWStackItem)*FStackCapacity);
     FillByte(FStack[FStackPointer],SizeOf(TLRSOWStackItem)*(FStackCapacity-FStackPointer),0);
   end;
-  //if AName<>'' then DebugLn(['TLRSObjectWriter.Push AName=',AName,' Instance=',DbgsName(Instance),' PushCount=',PushCount,' SkipIfEmpty=',SkipIfEmpty]);
+  //if AName<>'' then DebugLn(['TLRSObjectWriter.Push AName=',AName, ' Type=', GetEnumName(TypeInfo(TLRSItemType), Integer(ItemType)),' PushCount=',PushCount,' SkipIfEmpty=',SkipIfEmpty]);
   FStack[FStackPointer].Name:=AName;
-  FStack[FStackPointer].Instance:=Instance;
+  FStack[FStackPointer].ItemType:=ItemType;
+  FStack[FStackPointer].Root:=Root;
   FStack[FStackPointer].PushCount:=PushCount;
+  FStack[FStackPointer].ItemNr:=-1;
   FStack[FStackPointer].SkipIfEmpty:=SkipIfEmpty;
   FStack[FStackPointer].BufCount:=0;
   if SkipIfEmpty then
@@ -4472,7 +4642,7 @@
 procedure TLRSObjectWriter.BeginCollection;
 begin
   //DebugLn(['TLRSObjectWriter.BeginCollection ',FStackPointer]);
-  Push;
+  Push(lrsitCollection);
   WriteValue(vaCollection);
 end;
 
@@ -4481,15 +4651,34 @@
 var
   Prefix: Byte;
   CanBeOmitted: boolean;
+  ItemName: String;
+  ItemRoot: TComponent;
 begin
   //DebugLn(['TLRSObjectWriter.BeginComponent ',FStackPointer]);
   // an inherited child component can be omitted if empty
   CanBeOmitted:=(not WriteEmptyInheritedChilds)
             and (FStackPointer>0) and (ffInherited in Flags)
             and (not (ffChildPos in Flags));
-  // a component has two lists: properties and childs
-  Push(Component.Name,Component,2,CanBeOmitted);
 
+  // Top component is addressed by ClassName.
+  if FStackPointer = 0 then
+  begin
+    ItemName := Component.ClassName;
+    ItemRoot := nil;
+  end
+  else
+  begin
+    ItemName := Component.Name;
+    if Assigned(Writer) then
+      // Writer.Root is the current Root component.
+      ItemRoot := Writer.Root
+    else
+      ItemRoot := nil;
+  end;
+
+  // A component has two lists: properties and childs, hence PopCount=2.
+  Push(lrsitComponent, ItemName, ItemRoot, 2, CanBeOmitted);
+
   if not FSignatureWritten then
   begin
     Write(FilerSignature[1], length(FilerSignature));
@@ -4519,8 +4708,11 @@
 
 procedure TLRSObjectWriter.BeginList;
 begin
+  // Increase counter for next collection item.
+  if (FStackPointer > 0) and (FStack[FStackPointer-1].ItemType = lrsitCollection) then
+    Inc(FStack[FStackPointer-1].ItemNr);
   //DebugLn(['TLRSObjectWriter.BeginList ',FStackPointer]);
-  Push;
+  Push(lrsitList);
   WriteValue(vaList);
 end;
 
@@ -4528,13 +4720,12 @@
 begin
   //DebugLn(['TLRSObjectWriter.EndList ',FStackPointer]);
   Pop(true);
-  //WriteValue(vaNull);
 end;
 
 procedure TLRSObjectWriter.BeginProperty(const PropName: String);
 begin
   //DebugLn(['TLRSObjectWriter.BeginProperty ',FStackPointer,' ',PropName]);
-  Push(PropName);
+  Push(lrsitProperty, PropName);
   WriteStr(PropName);
 end;
 
@@ -4544,32 +4735,35 @@
   Pop(false);
 end;
 
-function TLRSObjectWriter.GetStackPath(Root: TComponent): string;
+function TLRSObjectWriter.GetStackPath: string;
 var
   i: Integer;
-  CurInstance: TPersistent;
-  CurComponent: TComponent;
   CurName: string;
+  Item: PLRSOWStackItem;
 begin
   Result:='';
-  for i:=0 to FStackPointer-1 do begin
-    CurInstance:=FStack[i].Instance;
-    if (CurInstance is TComponent) and (Root<>nil) then begin
-      CurComponent:=TComponent(CurInstance);
-      if CurComponent=Root then begin
-        Result:=CurComponent.ClassName;
-        continue;
-      end;
-      if CurComponent.Owner=Root then begin
-        Result:=CurComponent.Owner.ClassName+'.'+CurComponent.Name;
-        continue;
-      end;
+
+  for i:=0 to FStackPointer-1 do
+  begin
+    Item := @FStack[i];
+
+    // Writer.LookupRoot is the top component in the module.
+    if Assigned(Writer) and
+       (Item^.ItemType = lrsitComponent) and
+       (Item^.Root = Writer.LookupRoot) and
+       (Item^.Root <> nil) then
+    begin
+      // Restart path from top component.
+      Result := Item^.Root.ClassName;
     end;
-    CurName:=FStack[i].Name;
+
+    CurName:=Item^.Name;
     if CurName<>'' then begin
       if Result<>'' then Result:=Result+'.';
       Result:=Result+CurName;
     end;
+    if Item^.ItemNr >= 0 then
+      Result := Result + '[' + IntToStr(Item^.ItemNr) + ']';
   end;
 end;
 
lrt_collections.diff (20,140 bytes)   

2010-12-16 00:51

 

2010-12-16 00:51

 

main.lrt.diff3 (4,632 bytes)

Mattias Gaertner

2011-01-25 19:50

manager   ~0045472

Thanks. Applied.

cobines

2011-01-26 02:22

reporter   ~0045479

Thanks.

Issue History

Date Modified Username Field Change
2010-06-16 19:54 cobines New Issue
2010-06-16 19:54 cobines File Added: collections_lrt_example.tar.bz2
2010-10-29 14:13 Vincent Snijders LazTarget => -
2010-10-29 14:13 Vincent Snijders Assigned To => Mattias Gaertner
2010-10-29 14:13 Vincent Snijders Status new => assigned
2010-12-16 00:50 cobines Note Added: 0044257
2010-12-16 00:51 cobines File Added: lrt_collections.diff
2010-12-16 00:51 cobines File Added: lrt_translation_test.tar.bz2
2010-12-16 00:51 cobines File Added: main.lrt.diff3
2011-01-07 09:27 Vincent Snijders LazTarget - => 0.9.30
2011-01-07 09:27 Vincent Snijders Target Version => 0.9.30
2011-01-07 09:27 Vincent Snijders Relationship added related to 0015180
2011-01-25 19:50 Mattias Gaertner Fixed in Revision => 29201
2011-01-25 19:50 Mattias Gaertner Note Added: 0045472
2011-01-25 19:50 Mattias Gaertner Status assigned => resolved
2011-01-25 19:50 Mattias Gaertner Resolution open => fixed
2011-01-25 19:56 Vincent Snijders Tag Attached: merge to 0.9.30
2011-01-26 02:22 cobines Status resolved => closed
2011-01-26 02:22 cobines Note Added: 0045479