* FPDoc / FCL/PasSrc: Added variant record support to parser and HTML writer

git-svn-id: trunk@456 -

fcl/passrc/pastree.pp

@@ -2,7 +2,7 @@
     This file is part of the Free Component Library
 
     Pascal parse tree classes
-    Copyright (c) 2000-2003 by
+    Copyright (c) 2000-2005 by
       Areca Systems GmbH / Sebastian Guenther, [email protected]
 
     See the file COPYING.FPC, included in this distribution,
@@ -89,7 +89,7 @@ type
     function GetDeclaration(full : Boolean) : string; virtual;
     Visibility: TPasMemberVisibility;
     property RefCount: LongWord read FRefCount;
-    property Name: string read FName write Fname;
+    property Name: string read FName write FName;
     property Parent: TPasElement read FParent;
   end;
 
@@ -204,6 +204,16 @@ type
     EnumType: TPasType;
   end;
 
+  TPasRecordType = class;
+
+  TPasVariant = class(TPasElement)
+  public
+    constructor Create(const AName: string; AParent: TPasElement); override;
+    destructor Destroy; override;
+    Values: TStringList;
+    Members: TPasRecordType;
+  end;
+
   TPasRecordType = class(TPasType)
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
@@ -212,6 +222,9 @@ type
     function GetDeclaration(full : boolean) : string; override;
     IsPacked: Boolean;
     Members: TList;     // array of TPasVariable elements
+    VariantName: string;
+    VariantType: TPasType;
+    Variants: TList;	// array of TPasVariant elements, may be nil!
   end;
 
 
@@ -704,6 +717,21 @@ begin
 end;
 
 
+constructor TPasVariant.Create(const AName: string; AParent: TPasElement);
+begin
+  inherited Create(AName, AParent);
+  Values := TStringList.Create;
+end;
+
+destructor TPasVariant.Destroy;
+begin
+  Values.Free;
+  if Assigned(Members) then
+    Members.Release;
+  inherited Destroy;
+end;
+
+
 constructor TPasRecordType.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
@@ -717,6 +745,17 @@ begin
   for i := 0 to Members.Count - 1 do
     TPasVariable(Members[i]).Release;
   Members.Free;
+
+  if Assigned(VariantType) then
+    VariantType.Release;
+
+  if Assigned(Variants) then
+  begin
+    for i := 0 to Variants.Count - 1 do
+      TPasVariant(Variants[i]).Release;
+    Variants.Free;
+  end;
+
   inherited Destroy;
 end;
 
@@ -1096,7 +1135,6 @@ function TPasEnumType.GetDeclaration (full : boolean) : string;
 
 Var
   S : TStringList;
-  i : integer;
 
 begin
   S:=TStringList.Create;
@@ -1343,7 +1381,6 @@ function TPasProcedure.GetDeclaration (full : boolean) : string;
 
 Var
   S : TStringList;
-  Index : integer;
 begin
   S:=TStringList.Create;
   try

utils/fpdoc/dw_html.pp

@@ -1,7 +1,6 @@
 {
-
     FPDoc  -  Free Pascal Documentation Tool
-    Copyright (C) 2000 - 2003 by
+    Copyright (C) 2000 - 2005 by
       Areca Systems GmbH / Sebastian Guenther, [email protected]
 
     * HTML/XHTML output generator
@@ -191,7 +190,8 @@ type
     procedure AppendShortDescrCell(Parent: TDOMNode; Element: TPasElement);
     function AppendHyperlink(Parent: TDOMNode; Element: TPasElement): TDOMElement;
     function AppendType(CodeEl, TableEl: TDOMElement;
-      Element: TPasType; Expanded: Boolean): TDOMElement;
+      Element: TPasType; Expanded: Boolean;
+      NestingLevel: Integer = 0): TDOMElement;
     function AppendProcType(CodeEl, TableEl: TDOMElement;
       Element: TPasProcedureType; Indent: Integer): TDOMElement;
     procedure AppendProcExt(CodeEl: TDOMElement; Element: TPasProcedure);
@@ -199,6 +199,8 @@ type
       Element: TPasProcedureBase);
     procedure AppendProcArgsSection(Parent: TDOMNode;
       Element: TPasProcedureType);
+    function AppendRecordType(CodeEl, TableEl: TDOMElement;
+      Element: TPasRecordType; NestingLevel: Integer): TDOMElement;
 
     procedure AppendTitle(const AText: DOMString);
     procedure AppendMenuBar(ASubpageIndex: Integer);
@@ -1362,7 +1364,7 @@ end;
 
 { Returns the new CodeEl, which will be the old CodeEl in most cases }
 function THTMLWriter.AppendType(CodeEl, TableEl: TDOMElement;
-  Element: TPasType; Expanded: Boolean): TDOMElement;
+  Element: TPasType; Expanded: Boolean; NestingLevel: Integer): TDOMElement;
 begin
   Result := CodeEl;
 
@@ -1388,6 +1390,9 @@ begin
   if Element.InheritsFrom(TPasRangeType) then
     AppendPasSHFragment(CodeEl, TPasRangeType(Element).RangeStart + '..' +
       TPasRangeType(Element).RangeEnd, 0)
+  // Record type
+  else if Element.ClassType = TPasRecordType then
+    Result := AppendRecordType(CodeEl, TableEl, TPasRecordType(Element), NestingLevel)
   else
   // Other types
     AppendHyperlink(CodeEl, Element);
@@ -1579,6 +1584,76 @@ begin
   end;
 end;
 
+function THTMLWriter.AppendRecordType(CodeEl, TableEl: TDOMElement;
+  Element: TPasRecordType; NestingLevel: Integer): TDOMElement;
+var
+  i, j: Integer;
+  Variable: TPasVariable;
+  TREl, TDEl: TDOMElement;
+  CurVariant: TPasVariant;
+begin
+  if not (Element.Parent is TPasVariant) then
+    if Element.IsPacked then
+      AppendKw(CodeEl, 'packed record')
+    else
+      AppendKw(CodeEl, 'record');
+
+  for i := 0 to Element.Members.Count - 1 do
+  begin
+    Variable := TPasVariable(Element.Members[i]);
+    TREl := CreateTR(TableEl);
+    CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
+    AppendShortDescrCell(TREl, Variable);
+    AppendNbSp(CodeEl, NestingLevel * 2 + 2);
+    AppendText(CodeEl, Variable.Name);
+    AppendSym(CodeEl, ': ');
+    CodeEl := AppendType(CodeEl, TableEl, Variable.VarType, False, NestingLevel + 1);
+    AppendSym(CodeEl, ';');
+  end;
+
+  if Assigned(Element.VariantType) then
+  begin
+    TREl := CreateTR(TableEl);
+    CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
+    AppendNbSp(CodeEl, NestingLevel * 2 + 2);
+    AppendKw(CodeEl, 'case ');
+    if TPasRecordType(Element).VariantName <> '' then
+    begin
+      AppendText(CodeEl, TPasRecordType(Element).VariantName);
+      AppendSym(CodeEl, ': ');
+    end;
+    CodeEl := AppendType(CodeEl, TableEl, TPasRecordType(Element).VariantType, True);
+    AppendKw(CodeEl, ' of');
+    for i := 0 to TPasRecordType(Element).Variants.Count - 1 do
+    begin
+      CurVariant := TPasVariant(Element.Variants[i]);
+      TREl := CreateTR(TableEl);
+      CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
+      AppendNbSp(CodeEl, NestingLevel * 2 + 4);
+      for j := 0 to CurVariant.Values.Count - 1 do
+      begin
+	if j > 0 then
+	  AppendSym(CodeEl, ', ');
+	AppendPasSHFragment(CodeEl, CurVariant.Values[j], 0);
+      end;
+      AppendSym(CodeEl, ': (');
+      AppendType(CodeEl, TableEl, CurVariant.Members, True, NestingLevel + 3);
+      CodeEl := CreateCode(CreatePara(CreateTD_vtop(CreateTR(TableEl))));
+      AppendNbSp(CodeEl, NestingLevel * 2 + 6);
+      AppendSym(CodeEl, ');');
+    end;
+  end;
+
+  if not (Element.Parent is TPasVariant) then
+  begin
+    CodeEl := CreateCode(CreatePara(CreateTD(CreateTR(TableEl))));
+    AppendText(CodeEl, ' '); // !!!: Dirty trick, necessary for current XML writer
+    AppendNbSp(CodeEl, NestingLevel * 2);
+    AppendKw(CodeEl, 'end');
+  end;
+  Result := CodeEl;
+end;
+
 procedure THTMLWriter.AppendTitle(const AText: DOMString);
 begin
   AppendText(TitleElement, AText);
@@ -2211,27 +2286,7 @@ begin
     // Record
     if AType.ClassType = TPasRecordType then
     begin
-      if TPasRecordType(AType).IsPacked then
-        AppendKw(CodeEl, 'packed record')
-      else
-        AppendKw(CodeEl, 'record');
-
-      for i := 0 to TPasRecordType(AType).Members.Count - 1 do
-      begin
-        Variable := TPasVariable(TPasRecordType(AType).Members[i]);
-        TREl := CreateTR(TableEl);
-        CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
-        AppendShortDescrCell(TREl, Variable);
-        AppendNbSp(CodeEl, 2);
-        AppendText(CodeEl, Variable.Name);
-        AppendSym(CodeEl, ': ');
-        AppendType(CodeEl, TableEl, Variable.VarType, False);
-        AppendSym(CodeEl, ';');
-      end;
-
-      CodeEl := CreateCode(CreatePara(CreateTD(CreateTR(TableEl))));
-      AppendText(CodeEl, ' '); // !!!: Dirty trick, necessary for current XML writer
-      AppendKw(CodeEl, 'end');
+      CodeEl := AppendRecordType(CodeEl, TableEl, TPasRecordType(AType), 0);
       AppendSym(CodeEl, ';');
     end else
     // Set