usourcecommentextraction.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

          Desc.DefaultValue.StrData := '^(.*)$';
         end;
     9:  begin
          Desc.Name := 'CommentPatternContentIndex';
          Desc.Category := 'Comments.Extract';
          Desc.Description := 'The sub-expression in "CommentPattern" to use as the content of the comment; 0 to disable matching.';
          Desc.DataType := otInteger;
          Desc.MinInt := 0;
  {$IFNDEF NOREGULAREXPRESSIONS}
          Desc.MaxInt := RegExpr.NSUBEXP;
  {$ELSE}
          Desc.Options := [ooNoRead, ooNoWrite];
  {$ENDIF}
          Desc.DefaultValue.IntData := 0;
         end;
     10: begin
          Desc.Name := 'LinePattern';
          Desc.Category := 'Comments.Extract';
          Desc.Description := 'Regular Expression to extract the content from each line of comments, the number of the sub-expression to use is set via "CommentPatternContentIndex".';
          Desc.DataType := otString;
  {$IFDEF NOREGULAREXPRESSIONS}
          Desc.Options := [ooNoRead, ooNoWrite];
  {$ENDIF}
          Desc.DefaultValue.StrData := '^(.*)$';
         end;
     11: begin
          Desc.Name := 'LinePatternContentIndex';
          Desc.Category := 'Comments.Extract';
          Desc.Description := 'The sub-expression in "CommentPattern" to use as for each line as the content of the comment; 0 to disable matching.';
          Desc.DataType := otInteger;
          Desc.MinInt := 0;
  {$IFNDEF NOREGULAREXPRESSIONS}
          Desc.MaxInt := RegExpr.NSUBEXP;
  {$ELSE}
          Desc.Options := [ooNoRead, ooNoWrite];
  {$ENDIF}
          Desc.DefaultValue.IntData := 0;
         end;
     12: begin
          Desc.Name := 'TransformTabToSpaces';
          Desc.Category := 'Comments.Extract';
          Desc.Description := 'Whether tabulator characters should be transformed to spaces, like the Delphi IDE does by default.';
          Desc.DataType := otBoolean;
          Desc.DefaultValue.BoolData := True;
         end;
     13: begin
          Desc.Name := 'TabulatorWidth';
          Desc.Category := 'Comments.Extract';
          Desc.Description := 'The width of a tabulator character (the distances between tab-stops) if "TransformTabToSpaces" is enabled.';
          Desc.DataType := otInteger;
          Desc.DefaultValue.IntData := 8;
          Desc.MinInt := 2;
          Desc.MaxInt := 257;
         end;
     14: begin
          Desc.Name := 'RemoveTrailingWhiteSpaces';
          Desc.Category := 'Comments.Extract';
          Desc.Description := 'Whether whitespaces at the end of lines should be removed, like the Delphi IDE does by default.';
          Desc.DataType := otBoolean;
          Desc.DefaultValue.BoolData := True;
         end;
     15: begin
          Desc.Name := 'CommentMarker';
          Desc.Category := 'Comments.Filter';
          Desc.Description := 'The marking of comments to be included in the documentation, all other comments will be ignored, depending on option "CommentMarkerAction".';
          Desc.DataType := otString;
         end;
     16: begin
          Desc.Name := 'CommentMarkerAction';
          Desc.Category := 'Comments.Filter';
          Desc.Description := 'The action to do if comments have a special marker, the marker itself is defined by option "CommentMarker".';
          Desc.DataType := otEnumeration;
          Desc.EnumNames := CommentMarkerActionEnumerationList;
         end;
     17: begin
          Desc.Name := 'CommentMarkerAfterWhiteSpace';
          Desc.Category := 'Comments.Filter';
          Desc.Description := 'Whether the marker of option "CommentMarker" has not to be directly at the beginning of the comments but some whitespaces may be before it.';
          Desc.DataType := otBoolean;
         end;
   else
    Assert(Index >= GetOptionCount);       //invalid index!
    raise EInvalidOption.Create('Invalid index for option supplied!');
   end;
 end;
end;

{Gets the value of an option. Call ~[link GetOptionDescription] to get the type
 and the meaning of the option.
~param Index index of the option to get the value of
~result the value of the option }
function TSourceCommentExtractor.GetOption(Index: Cardinal): TOptionValue;
var      PreOptionCount  :Cardinal;             //number of inherited options
begin
 PreOptionCount := inherited GetOptionCount;    //get number of inherited ones
 if Index < PreOptionCount then                 //asked for inherited option?
  Result := inherited GetOption(Index)            //forward to parent class
 else
  case Index - PreOptionCount of               //depending on index of option
    0:  Result.BoolData := FIgnoreIdentifierComments;  //get the value
    1:  Result.BoolData := FIgnoreFileComments;
    2:  Result.BoolData := FGetForwardComments;
    3:  Result.BoolData := FFallBackToOtherPositionForComment;
    4:  Result.BoolData := FFileCommentAfterFirstStatement;
    5:  Result.BoolData := FUseOnlyStaredComments;
    6:  Result.BoolData := FRemoveLeadingStars;
    7:  Result.BoolData := FRemoveTrailingStars;
    8:  Result.StrData :=
{$IFNDEF NOREGULAREXPRESSIONS}
                          FCommentRegExprFilter.Expression;
{$ELSE}
                          '';
{$ENDIF}
    9:  Result.IntData :=
{$IFNDEF NOREGULAREXPRESSIONS}
                          FCommentRegExprContentIndex;
{$ELSE}
                          0;
{$ENDIF}
    10: Result.StrData :=
{$IFNDEF NOREGULAREXPRESSIONS}
                          FCommentRegExprPerLineFilter.Expression;
{$ELSE}
                          '';
{$ENDIF}
    11: Result.IntData :=
{$IFNDEF NOREGULAREXPRESSIONS}
                          FCommentRegExprPerLineContentIndex;
{$ELSE}
                          0;
{$ENDIF}
    12: Result.BoolData := FTransformTabToSpaces;
    13: Result.IntData := FTabulatorWidth;
    14: Result.BoolData := FRemoveTrailingWhiteSpaces;
    15: Result.StrData := FCommentMarker;
    16: Result.EnumData := Ord(FCommentMarkerAction);
    17: Result.BoolData := FCommentMarkerAfterWhiteSpace;
  else
   Assert(Index >= GetOptionCount);           //invalid index!
   raise EInvalidOption.Create('Invalid index for option supplied!');
  end;
end;

{Sets the value of an option. Call ~[link GetOptionDescription] to get the type
 and the meaning of the option.
~param Index index of the option to set the value
~param Value the new value of the option }
procedure TSourceCommentExtractor.SetOption(Index: Cardinal;
                                            const Value: TOptionValue);
var       PreOptionCount  :Cardinal;          //number of inherited options
begin
 PreOptionCount := inherited GetOptionCount;  //get number of inherited ones
 if Index < PreOptionCount then               //asked for inherited option?
  inherited SetOption(Index, Value)             //forward to parent class
 else
  case Index - PreOptionCount of                //depending on index of option
    0:  FIgnoreIdentifierComments := Value.BoolData;     //set the value
    1:  FIgnoreFileComments := Value.BoolData;
    2:  FGetForwardComments := Value.BoolData;
    3:  FFallBackToOtherPositionForComment := Value.BoolData;
    4:  FFileCommentAfterFirstStatement := Value.BoolData;
    5:  FUseOnlyStaredComments := Value.BoolData;
    6:  FRemoveLeadingStars := Value.BoolData;
    7:  FRemoveTrailingStars := Value.BoolData;
    8:
{$IFNDEF NOREGULAREXPRESSIONS}
        begin
         FCommentRegExprFilter.Expression := Value.StrData;
         FCommentRegExprFilter.Compile;    //check whether the regexpr is valid
        end
{$ENDIF}
           ;
    9:
{$IFNDEF NOREGULAREXPRESSIONS}
        begin
         if (Value.IntData < 0) or (Value.IntData > RegExpr.NSUBEXP) then
          raise Exception.CreateFmt('Value for sub-expression for Regular Expression to extract the comment is invalid: %d, must be between %d and %d.',
                                    [Value.IntData, 0, RegExpr.NSUBEXP]);
         FCommentRegExprContentIndex := Value.IntData
        end
{$ENDIF}
           ;
    10:
{$IFNDEF NOREGULAREXPRESSIONS}
        begin
         FCommentRegExprPerLineFilter.Expression := Value.StrData;
         FCommentRegExprPerLineFilter.Compile; //check whether regexpr is valid
        end
{$ENDIF}
           ;
    11:
{$IFNDEF NOREGULAREXPRESSIONS}
        begin
         if (Value.IntData < 0) or (Value.IntData > RegExpr.NSUBEXP) then
          raise Exception.CreateFmt('Value for sub-expression for Regular Expression to extract the comment is invalid: %d, must be between %d and %d.',
                                    [Value.IntData, 0, RegExpr.NSUBEXP]);
         FCommentRegExprPerLineContentIndex := Value.IntData
        end
{$ENDIF}
           ;
    12: FTransformTabToSpaces := Value.BoolData;
    13: begin
         if (Value.IntData < 2) or (Value.IntData > 50000) then
          raise Exception.CreateFmt('Value for distance between tabulator stops is invalid: %d',
                                    [Value.IntData]);
         FTabulatorWidth := Value.IntData;
        end;
    14: FRemoveTrailingWhiteSpaces := Value.BoolData;
    15: FCommentMarker := Value.StrData;
    16: FCommentMarkerAction := TCommentMarkerAction(Value.EnumData);
    17: FCommentMarkerAfterWhiteSpace := Value.BoolData;
  else
   Assert(Index >= GetOptionCount);            //invalid index!
   raise EInvalidOption.Create('Invalid index for option supplied!');
  end;
end;









{Returns the comments about the identifier.
~param Ident the identifier whose comments should be returned
~result the comments about the identifier }
function TSourceCommentExtractor.Comment(Ident: TIdentifier): TComment;

 {Returns the comment of the identifier whose (forward) declaration is in the
  given line.
 ~param Line       the line the identifier is (forward-)declared in
 ~param SourceFile the file the identifier is declared in
 ~result the comment of the identifier }
 function GetIdentComment(Line: Integer; SourceFile: TPascalFile): String;
 var      TabWidths      :Integer;    //value for the widths of tabulator stops
 begin
  //predefined identifiers in unit System will be declared at row 0/-1
  if Line >= 0 then
   begin
    //tabulator characters must be transformed to spaces?
    if FTransformTabToSpaces then
     TabWidths := FTabulatorWidth         //use the specified width
    else
     TabWidths := 0;                      //don't expand tabulator characters

    //get comment at the end of the line
    Result := ExtractComment(SourceFile.Lines[Line],
                             SourceFile.LineStartComment[Line],
                             True, TabWidths);
    Dec(Line);                            //then check the previous line(s)
    //while lines have no code and either line is not empty or is still in a
    //multi-line comment
    while (Line >= 0) and (TrimLeft(SourceFile.UncommentedLine[Line]) = '') and
          ((TrimLeft(SourceFile.Lines[Line]) <> '') or
           (SourceFile.LineStartComment[Line] <> ctNone)) do
     begin
      //prepend the comment of the line to the final comment
      Result := ExtractComment(SourceFile.Lines[Line],
                               SourceFile.LineStartComment[Line],
                               False, TabWidths) +
                #13#10 + Result;
      Dec(Line);                                //and test the previous line
     end;
   end
  else
   Result := '';                            //no comment for those
 end;

var      Text                   :String;    //the text of the comment
begin
 if FIgnoreIdentifierComments then  //comments should be ignored?
  Text := ''                          //just return an empty text
 else
  begin
   if FGetForwardComments then        //should the forward comments be used?
    //get the comment at the line of forward declaration
    Text := GetIdentComment(Ident.EffectiveForwardPosition.Row - 1,
                            Ident.EffectiveForwardFile)
   else
    //get the comment at the line of the final declaration
    Text := GetIdentComment(Ident.EffectivePosition.Row - 1,
                            Ident.EffectiveFile);



   //if no comment found and other position should be tried and other
   //position available
   if FFallBackToOtherPositionForComment and
      ((Ident.EffectivePosition.Row <> Ident.EffectiveForwardPosition.Row) or
       (Ident.EffectiveFile <> Ident.EffectiveForwardFile)) and
      (TrimLeft(Text) = '') then
    if FGetForwardComments then       //should the forward comments be used?
     //now use line of final declaration
     Text := GetIdentComment(Ident.EffectivePosition.Row - 1,
                             Ident.EffectiveFile)
    else
     //use line of forward declaration
     Text := GetIdentComment(Ident.EffectiveForwardPosition.Row - 1,
                             Ident.EffectiveForwardFile);
  end; //if FIgnoreIdentifierComments


 Result := ProcessComment(Text);    //return text as a comment
end;


{Returns the comments about the file.
~param AFile the file whose comments should be returned
~result the comments about the file }
function TSourceCommentExtractor.CommentOfFile(AFile: TPascalFile): TComment;

 {Returns the comment about the file.
 ~result the comment about the file }
 function GetFileComment: String;
 var      Line          :Integer;     //lines in the file
          Count         :Integer;     //number of lines in the file
          TabWidths     :Integer;     //value for the widths of tabulator stops
 begin
  Line := 0;                              //start at the top of the file
  Count := AFile.Lines.Count;             //get number of lines

  if FFileCommentAfterFirstStatement then //first line should be skipped?
   begin
    //while no statement in the line
    while (Line < Count) and (TrimLeft(AFile.UncommentedLine[Line]) = '') do
     Inc(Line);                               //skip it
    Inc(Line);                              //skip also the statement line
   end;

  //while no comment found in the line
  while (Line < Count) and (AFile.LineComment[Line] = '') do
   Inc(Line);                               //try the next line