diff --git a/components/codetools/tests/testcompreaderwriterpas.pas b/components/codetools/tests/testcompreaderwriterpas.pas index d7fc5af34b..c877564caa 100644 --- a/components/codetools/tests/testcompreaderwriterpas.pas +++ b/components/codetools/tests/testcompreaderwriterpas.pas @@ -472,6 +472,7 @@ type procedure TestInterface; procedure TestAncestor; procedure TestAncestorChildPos; + procedure TestWithLookupRootName; procedure TestChildComponents; procedure TestForeignReference; procedure TestCollection; @@ -940,9 +941,15 @@ begin Actual:=WriteDescendant(Component,Ancestor); ExpS:=CSPDefaultSignatureBegin+LineEnding; ExpS:=ExpS+Writer.GetVersionStatement+LineEnding; - ExpS:=ExpS+'Name:='''+Component.Name+''';'+LineEnding; + if cwpoWithLookupRootName in Writer.Options then begin + ExpS:=ExpS+'with '+Component.Name+' do begin'+LineEnding; + ExpS:=ExpS+' Name:='''+Component.Name+''';'+LineEnding; + end else + ExpS:=ExpS+'Name:='''+Component.Name+''';'+LineEnding; for s in Expected do ExpS:=ExpS+s+LineEnding; + if cwpoWithLookupRootName in Writer.Options then + ExpS:=ExpS+'end;'+LineEnding; ExpS:=ExpS+CSPDefaultSignatureEnd+LineEnding; CheckDiff(Msg,ExpS,Actual); AssertEquals(Msg+' NeedAccessClass',NeedAccessClass,Writer.NeedAccessClass); @@ -1570,6 +1577,96 @@ begin end; end; +procedure TTestCompReaderWriterPas.TestWithLookupRootName; + + procedure InitAncestor(C: TSimpleControl); + var + Button1, Panel2, Button21, Button22: TSimpleControl; + begin + C.Tag:=1; + Button1:=TSimpleControl.Create(C); + with Button1 do begin + Name:='Button1'; + Tag:=11; + Parent:=C; + end; + Panel2:=TSimpleControl.Create(C); + with Panel2 do begin + Name:='Panel2'; + Tag:=12; + Parent:=C; + Button21:=TSimpleControl.Create(C); + with Button21 do begin + Name:='Button21'; + Tag:=121; + Parent:=Panel2; + end; + Button22:=TSimpleControl.Create(C); + with Button22 do begin + Name:='Button22'; + Tag:=122; + Parent:=Panel2; + end; + end; + end; + +var + aRoot, Ancestor, Label1: TSimpleControl; +begin + Ancestor:=TSimpleControl.Create(nil); + aRoot:=TSimpleControl.Create(nil); + try + with Ancestor do begin + Name:='Ancestor'; + end; + InitAncestor(Ancestor); + + with aRoot do begin + Name:='Descendant'; + end; + InitAncestor(aRoot); + aRoot.Controls[0].Next:=aRoot; + aRoot.Next:=aRoot.Controls[0]; + Label1:=TSimpleControl.Create(aRoot); + with Label1 do begin + Name:='Label1'; + Parent:=aRoot; + end; + + // switch Button21 and Button22 + aRoot.Controls[1].FChildren.Move(0,1); + + // switch Button1 and Panel2 + aRoot.FChildren.Move(0,1); + + Writer.Options:=Writer.Options+[cwpoWithLookupRootName]; + TestWriteDescendant('TestWithLookupRootName',aRoot,Ancestor,[ + ' Label1:=TSimpleControl.Create(Descendant);', + ' Next:=Button1;', + ' with Panel2 do begin', + ' with Button22 do begin', + ' end;', + ' TPasStreamAccess(TComponent(Panel2)).SetChildOrder(Button22,0);', + ' with Button21 do begin', + ' end;', + ' TPasStreamAccess(TComponent(Panel2)).SetChildOrder(Button21,1);', + ' end;', + ' TPasStreamAccess(TComponent(Descendant)).SetChildOrder(Panel2,0);', + ' with Button1 do begin', + ' Next:=Descendant;', + ' end;', + ' TPasStreamAccess(TComponent(Descendant)).SetChildOrder(Button1,1);', + ' with Label1 do begin', + ' Name:=''Label1'';', + ' Parent:=Descendant;', + ' end;', + ''],true); + finally + aRoot.Free; + Ancestor.Free; + end; +end; + procedure TTestCompReaderWriterPas.TestChildComponents; var aRoot, Button1, Panel1: TSimpleControl; diff --git a/components/lazutils/compwriterpas.pas b/components/lazutils/compwriterpas.pas index 47010a5c2f..414042042b 100644 --- a/components/lazutils/compwriterpas.pas +++ b/components/lazutils/compwriterpas.pas @@ -11,6 +11,7 @@ Component serialisation into Pascal. Author: Mattias Gaertner Working: +- signature begin, end, version - boolean, set of boolean - char, widechar, custom char, set of custom char - integers, custom int, set of custom int @@ -69,9 +70,10 @@ type Instance: TPersistent; const Identifier: string; var Handled: boolean) of object; TCWPOption = ( - cwpoNoSignature, - cwpoSetParentFirst, // add "Parent:=" before properties - cwpoSrcCodepageUTF8 + cwpoNoSignature, // do not write Begin, End signatures + cwpoWithLookupRootName,// enclose in "with LookupRootname do begin" + cwpoSetParentFirst, // add "SetParentComponent" before setting properties, default: after + cwpoSrcCodepageUTF8 // target unit uses $codepage utf-8, aka do not convert UTF-8 string literals ); TCWPOptions = set of TCWPOption; @@ -139,6 +141,8 @@ type procedure WriteLn; procedure WriteStatement(const s: string); procedure WriteAssign(const LHS, RHS: string); + procedure WriteWithDo(const Expr: string); + procedure WriteWithEnd; function GetComponentPath(Component: TComponent): string; function GetBoolLiteral(b: boolean): string; function GetCharLiteral(c: integer): string; @@ -453,8 +457,7 @@ begin WriteChildren(Instance,cwpcsCreate); end else begin - WriteStatement('with '+Instance.Name+' do begin'); - Indent; + WriteWithDo(Instance.Name); if not CreatedByAncestor(Instance) then WriteAssign('Name',''''+Instance.Name+''''); if cwpoSetParentFirst in Options then @@ -466,14 +469,11 @@ begin if not IgnoreChildren then WriteChildren(Instance,cwpcsProperties); if Instance<>LookupRoot then - begin - Unindent; - WriteStatement('end;'); - end; + WriteWithEnd; if HasAncestor and (Ancestor<>FRootAncestor) and (FCurrentPos<>FAncestorPos) then begin - if Parent=LookupRoot then + if (Parent=LookupRoot) and not (cwpoWithLookupRootName in Options) then WriteStatement('SetChildOrder('+GetComponentPath(Instance)+','+IntToStr(FCurrentPos)+');') else begin NeedAccessClass:=true; @@ -1121,11 +1121,9 @@ begin for i:=0 to Collection.Count-1 do begin Item:=Collection.Items[i]; - WriteStatement('with '+Item.ClassName+'('+PropName+'.Add) do begin'); - Indent; + WriteWithDo(Item.ClassName+'('+PropName+'.Add)'); WriteProperties(Item); - Unindent; - WriteStatement('end;'); + WriteWithEnd; end; end; @@ -1137,7 +1135,12 @@ begin if Component=nil then Result:='Nil' else if Component=LookupRoot then - Result:='Self' + begin + if cwpoWithLookupRootName in Options then + Result:=LookupRoot.Name + else + Result:='Self'; + end else begin Name:= ''; C:=Component; @@ -1152,7 +1155,10 @@ begin end else if C = LookupRoot then begin - Name := 'Self'+Name; + if cwpoWithLookupRootName in Options then + Name := C.Name+Name + else + Name := 'Self'+Name; break; end else if C.Name='' then exit(''); @@ -1437,7 +1443,7 @@ begin DetermineAncestor(Component); HasAncestor:=FAncestor is TComponent; if not CreatedByAncestor(Component) then - WriteAssign(Component.Name,Component.ClassName+'.Create(Self)'); + WriteAssign(Component.Name,Component.ClassName+'.Create('+GetComponentPath(Root)+')'); if HasAncestor then begin if (csInline in Component.ComponentState) and not (csInline in TComponent(Ancestor).ComponentState) then @@ -1490,7 +1496,11 @@ begin if not (cwpoNoSignature in Options) then WriteStatement(SignatureBegin); WriteStatement(GetVersionStatement); + if cwpoWithLookupRootName in Options then + WriteWithDo(ARoot.Name); WriteComponent(ARoot); + if cwpoWithLookupRootName in Options then + WriteWithEnd; if not (cwpoNoSignature in Options) then WriteStatement(SignatureEnd); end; @@ -1528,6 +1538,18 @@ begin WriteLn; end; +procedure TCompWriterPas.WriteWithDo(const Expr: string); +begin + WriteStatement('with '+Expr+' do begin'); + Indent; +end; + +procedure TCompWriterPas.WriteWithEnd; +begin + Unindent; + WriteStatement('end;'); +end; + function TCompWriterPas.CreatedByAncestor(Component: TComponent): boolean; begin Result:=(FAncestor is TComponent)