* Allow to parametrize for documentation writing

packages/fcl-passrc/src/paswrite.pp

@@ -45,8 +45,12 @@ type
                       woNoAsm,         // Do not allow asm block
                       woSkipPrivateExternals,  // Skip generation of external procedure declaration in implementation section
                       woAlwaysRecordHelper,     // Force use of record helper for type helper
-                      woSkipHints          // Do not add identifier hints
+                      woSkipHints,          // Do not add identifier hints
+                      woSparse,             // Generate sparse code, used to generate declarations suitable for documenation
+                      woDocHints            // When generating sparse code, additionally add documentation hints. (rw for properties etc.)
                       );
+  TElementFlag = (efSkipSection,efMember,efForceBody,efParent);
+  TElementFlags = set of TElementFlag;
   TPasWriterOptions = Set of TPasWriterOption;
 
   TOnUnitAlias = function(const UnitName : String) : String of Object;
@@ -61,6 +65,7 @@ type
     FLineNumberWidth: Integer;
     FOnUnitAlias: TOnUnitAlias;
     FOPtions: TPasWriterOptions;
+    FSkipVisibilities: TPasMemberVisibilities;
     FStream: TStream;
     FIndentSize : Integer;
     IsStartOfLine: Boolean;
@@ -70,9 +75,12 @@ type
     CurDeclSection: string;
     DeclSectionStack: TList;
     FInImplementation : Boolean;
+    procedure AddAsLines(aLines: String);
     procedure SetForwardClasses(AValue: TStrings);
     procedure SetIndentSize(AValue: Integer);
     function CheckUnitAlias(const AUnitName : String) : String;
+    procedure WriteProcDecl(AProc: TPasProcedure; ForceBody: Boolean=False; NamePrefix: String='');
+    procedure WriteProcDecl(AProc: TPasProcedure; aFlags: TElementFlags; NamePrefix: String='');
   protected
     procedure DisableHintsWarnings;
     procedure PrepareDeclSectionInStruct(const ADeclSection: string);
@@ -105,6 +113,7 @@ type
     procedure WriteResourceString(aStr: TPasResString); virtual;
     procedure WriteEnumType(AType: TPasEnumType); virtual;
     procedure WriteElement(AElement: TPasElement;SkipSection : Boolean = False);virtual;
+    procedure WriteElement(AElement: TPasElement; aFlags : TElementFlags);virtual;
     procedure WriteType(AType: TPasType; Full : Boolean = True);virtual;
     procedure WriteProgram(aModule : TPasProgram); virtual;
     Procedure WriteLibrary(aModule : TPasLibrary); virtual;
@@ -122,10 +131,10 @@ type
     Procedure WriteRecordType(AType : TPasRecordType); virtual;
     Procedure WriteArrayType(AType : TPasArrayType; Full : Boolean = True); virtual;
     procedure WriteProcType(AProc: TPasProcedureType);  virtual;
-    procedure WriteProcDecl(AProc: TPasProcedure; ForceBody: Boolean = False; NamePrefix : String = ''); virtual;
     procedure WriteProcImpl(AProc: TProcedureBody; IsAsm : Boolean = false); virtual;
     procedure WriteProcImpl(AProc: TPasProcedureImpl); virtual;
     procedure WriteProperty(AProp: TPasProperty); virtual;
+    procedure WriteProperty(AProp: TPasProperty; aFlags : TElementFlags); virtual;
     procedure WriteImplBlock(ABlock: TPasImplBlock);  virtual;
     procedure WriteImplElement(AElement: TPasImplElement; AAutoInsertBeginEnd: Boolean); virtual;
     procedure WriteImplCommand(ACommand: TPasImplCommand);virtual;
@@ -149,6 +158,7 @@ type
     procedure wrtln;overload; deprecated ;
     property Stream: TStream read FStream;
   Published
+    Property SkipVisibilities : TPasMemberVisibilities Read FSkipVisibilities Write FSkipVisibilities;
     Property OnUnitAlias : TOnUnitAlias Read FOnUnitAlias Write FOnUnitAlias;
     Property Options : TPasWriterOptions Read FOPtions Write FOptions;
     Property IndentSize : Integer Read FIndentSize Write SetIndentSize;
@@ -178,6 +188,7 @@ begin
   FForwardClasses:=TStringList.Create;
   FLineEnding:=sLineBreak;
   FLineNumberWidth:=4;
+  FSkipVisibilities:=[];
 end;
 
 destructor TPasWriter.Destroy;
@@ -248,16 +259,24 @@ begin
 end;
 
 procedure TPasWriter.WriteElement(AElement: TPasElement;SkipSection : Boolean = False);
+begin
+  if SkipSection then
+    WriteElement(aElement,[])
+  else
+    WriteElement(aElement,[efSkipSection])
+end;
+
+procedure TPasWriter.WriteElement(AElement: TPasElement; aFlags : TElementFlags);
 
 begin
-  if not SkipSection then
+  if not (efSkipSection in aFlags) then
     MaybeSetLineElement(AElement);
   if AElement.InheritsFrom(TPasModule) then
     WriteModule(TPasModule(AElement))
   else if AElement.InheritsFrom(TPasSection) then
     WriteSection(TPasSection(AElement))
   else if AElement.ClassType.InheritsFrom(TPasProperty) then
-    WriteProperty(TPasProperty(AElement))
+    WriteProperty(TPasProperty(AElement), aFlags)
   else if AElement.InheritsFrom(TPasConst) then
     WriteConst(TPasConst(AElement)) // Must be before variable
   else if AElement.InheritsFrom(TPasVariable) then
@@ -271,7 +290,7 @@ begin
   else if AElement.InheritsFrom(TPasProcedureImpl) then // This one must come before TProcedureBody/TPasProcedure
     WriteProcImpl(TPasProcedureImpl(AElement))
   else if AElement.InheritsFrom(TPasProcedure) then
-    WriteProcDecl(TPasProcedure(AElement))
+    WriteProcDecl(TPasProcedure(AElement),aFlags)
   else if AElement.InheritsFrom(TProcedureBody) then
     WriteProcImpl(TProcedureBody(AElement))
   else if AElement.InheritsFrom(TPasImplCommand) or AElement.InheritsFrom(TPasImplCommands) then
@@ -730,6 +749,8 @@ begin
     begin
     Member := TPasElement(aMembers[i]);
     CurVisibility := Member.Visibility;
+    if CurVisibility in SkipVisibilities then
+      Continue;
     if (CurVisibility <> LastVisibility) or ForceVisibility then
       begin
       DecIndent;
@@ -744,7 +765,7 @@ begin
       LastVisibility := CurVisibility;
       CurDeclSection := '';
       end;
-    WriteElement(Member);
+    WriteElement(Member,[efMember]);
     LastMember := Member;
     end;
 end;
@@ -877,10 +898,25 @@ begin
     Add(AType.Name)
 end;
 
+procedure TPasWriter.AddAsLines(aLines : String);
+var
+  L : TStrings;
+  aLine : string;
+begin
+  L:=TStringList.Create;
+  try
+    L.Text:=aLines;
+    For aLine in L do
+      AddLn(aLine);
+  finally
+    L.Free;
+  end;
+end;
+
 procedure TPasWriter.WriteRecordType(AType: TPasRecordType);
 
 Var
-  Temp : String;
+  Temp,TempVar : String;
   i : Integer;
   
 begin
@@ -911,7 +947,11 @@ begin
       temp:=temp+' of';
       AddLn(Temp);
       For I:=0 to AType.Variants.Count-1 do
-        AddLn(TPasVariant(AType.Variants[i]).GetDeclaration(True));
+        begin
+        INcIndent;
+        AddAsLines(TPasVariant(AType.Variants[i]).GetDeclaration(True));
+        DecIndent;
+        end;
       end;
   DecDeclSectionLevel;
   DecIndent;
@@ -934,6 +974,15 @@ end;
 
 
 procedure TPasWriter.WriteProcDecl(AProc: TPasProcedure; ForceBody : Boolean = False; NamePrefix : String = '');
+begin
+  if ForceBody then
+    WriteProcDecl(aProc,[efForceBody],NamePrefix)
+  else
+    WriteProcDecl(aProc,[],NamePrefix)
+end;
+
+procedure TPasWriter.WriteProcDecl(AProc: TPasProcedure; aFlags: TElementFlags; NamePrefix : String = '');
+
 
   Procedure EmptyBody;
 
@@ -946,38 +995,28 @@ procedure TPasWriter.WriteProcDecl(AProc: TPasProcedure; ForceBody : Boolean = F
 Var
   AddExternal : boolean;
   IsImpl : Boolean;
+  ShowArgs, ShowModifiers, IsMember : boolean;
 
 begin
-
   IsImpl:=AProc.Parent is TImplementationSection;
   if IsImpl then
-    PrepareDeclSection('');
+    PrepareDeclSection('')
+  else
+    PrepareDeclSectionInStruct('');
   if Not IsImpl then
     IsImpl:=FInImplementation;
-  if FInImplementation and not forcebody and (Assigned(AProc.LibraryExpr) or Assigned(AProc.LibrarySymbolName)) and HasOption(woSkipPrivateExternals)  then
+  if FInImplementation and not (efForcebody in aFlags) and (Assigned(AProc.LibraryExpr) or Assigned(AProc.LibrarySymbolName)) and HasOption(woSkipPrivateExternals)  then
     Exit;
-  Add(AProc.GetDeclaration(True));
+  IsMember:=(efMember in aFlags);
+  ShowArgs:=Not (Ismember and (woSparse in Options));
+  ShowModifiers:=Not (IsImpl or (woSparse in Options));
+  Add(AProc.GetDeclaration(Not IsMember,ShowArgs,ShowModifiers,efParent in aFlags));
   Add(';');
   // delphi compatible order for example: procedure foo; reintroduce; overload; static;
-  if not IsImpl and AProc.IsReintroduced then
-    Add(' reintroduce;');
   // if NamePrefix is not empty, we're writing a dummy for external class methods.
   // In that case, we must not write the 'overload'.
   if AProc.IsOverload and (NamePrefix='') and not IsImpl then
     Add(' overload;');
-  if not IsImpl then
-    begin
-    if AProc.IsVirtual then
-      Add(' virtual;');
-    if AProc.IsDynamic then
-      Add(' dynamic;');
-    if AProc.IsAbstract then
-      Add(' abstract;');
-    if AProc.IsOverride then
-      Add(' override;');
-    if AProc.IsStatic then
-      Add(' static;');
-    end;
   if (pmAssembler in AProc.Modifiers) and Not (woNoAsm in OPtions) then
     Add(' assembler;');
   if AProc.CallingConvention<>ccDefault then
@@ -1007,7 +1046,7 @@ begin
     else
       WriteProcImpl(AProc.Body,pmAssembler in AProc.Modifiers)
     end
-  else if ForceBody then
+  else if (efForceBody in aFlags) then
     EmptyBody;
 end;
 
@@ -1132,8 +1171,14 @@ begin
 end;
 
 procedure TPasWriter.WriteProperty(AProp: TPasProperty);
+begin
+  WriteProperty(aProp,[]);
+end;
+
+procedure TPasWriter.WriteProperty(AProp: TPasProperty; aFlags : TElementFlags);
 var
   i: Integer;
+  s : string;
 begin
   if AProp.IsClass then
     Add('class ');
@@ -1154,21 +1199,41 @@ begin
     Add(': ');
     WriteType(AProp.VarType,False);
   end;
-  if AProp.IndexValue <> '' then
-    Add(' index ' + AProp.IndexValue); 
-  if AProp.ReadAccessorName <> '' then
-    Add(' read ' + AProp.ReadAccessorName);
-  if AProp.WriteAccessorName <> '' then
-    Add(' write ' + AProp.WriteAccessorName);
-  if AProp.StoredAccessorName <> '' then
-    Add(' stored ' + AProp.StoredAccessorName);
-  if AProp.DefaultValue <> '' then
-    Add(' default ' + AProp.DefaultValue);
-  if AProp.IsNodefault then
-    Add(' nodefault');
-  if AProp.IsDefault then
-    Add('; default');
-  AddLn(';');
+  if not ((woSparse in Options) and (efMember in aFlags)) then
+    begin
+    if not (woSparse in Options) then
+      begin
+      if AProp.IndexValue <> '' then
+        Add(' index ' + AProp.IndexValue);
+      if AProp.ReadAccessorName <> '' then
+        Add(' read ' + AProp.ReadAccessorName);
+      if AProp.WriteAccessorName <> '' then
+        Add(' write ' + AProp.WriteAccessorName);
+      end;
+    if AProp.StoredAccessorName <> '' then
+      Add(' stored ' + AProp.StoredAccessorName);
+    if AProp.DefaultValue <> '' then
+      Add(' default ' + AProp.DefaultValue);
+    if AProp.IsNodefault then
+      Add(' nodefault');
+    if AProp.IsDefault then
+      Add('; default');
+    end;
+  S:='';
+  if (woSparse in Options) and (efMember in aFlags) then
+    begin
+    if AProp.ReadAccessorName <> '' then
+      S:=S+'r';
+    if AProp.WriteAccessorName <> '' then
+      S:=S+'w';
+    if AProp.StoredAccessorName <> '' then
+      S:=S+'s';
+    if AProp.DefaultValue <> '' then
+      S:=S+'d';
+   if s<>'' then
+     S:=' {'+S+'}';
+   end;
+  AddLn(';'+S);
 end;
 
 procedure TPasWriter.WriteImplBlock(ABlock: TPasImplBlock);
@@ -1635,15 +1700,17 @@ procedure TPasWriter.PrepareDeclSectionInStruct(const ADeclSection: string);
 
 begin
   if Not SameText(ADeclSection,CurDeclSection) then
-  begin
-    if ADeclSection <> '' then
     begin
+    if ADeclSection <> '' then
+      begin
       DecIndent;
       AddLn(ADeclSection);
       IncIndent;
-    end;
+      end
+    else
+      DecIndent;
     CurDeclSection := ADeclSection;
-  end;
+    end;
 end;
 
 procedure TPasWriter.SetForwardClasses(AValue: TStrings);