usourcecommentextraction.pas

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

  //tabulator characters must be transformed to spaces?
  if FTransformTabToSpaces then
   TabWidths := FTabulatorWidth             //use the specified width
  else
   TabWidths := 0;                          //don't expand tabulator characters

  Result := '';                           //no comment found so far

  //while lines have no code and either line is not empty or is still in a
  while (Line < Count) and                //multi-line comment
        (TrimLeft(AFile.UncommentedLine[Line]) = '') and
        ((TrimLeft(AFile.Lines[Line]) <> '') or
         (AFile.LineStartComment[Line] <> ctNone)) do
   begin
    //append the comment of the line to the final comment
    Result := Result + #13#10 +
              ExtractComment(AFile.Lines[Line], AFile.LineStartComment[Line],
                             False, TabWidths);
    Inc(Line);                              //and test the next line
   end;
  Delete(Result, 1, 2);                   //delete the first EOL marker
 end;

var      Text                   :String;    //the text of the comment
begin
 if FIgnoreFileComments then         //comments of files should be ignored?
  Text := ''                           //just return an empty text
 else
  Text := GetFileComment;              //get the comment of the current file

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





{Returns the additional user documentation in a file.
~param Text the content of the file to be returned as a comment
~result the user documentation as a comment }
function TSourceCommentExtractor.UserDocumentation(Text: String): TComment;
begin
 if FRemoveTrailingWhiteSpaces then  //trailing whitespaces in the lines
  Text := StripTrailingWhiteSpaces(Text);                //must be stripped?
 if FTransformTabToSpaces then       //tabulator characters must be transformed
  Text := TransformTabulators(Text, FTabulatorWidth);    //to spaces?

 Result := Sectionize(Text, True);        //just sectionize it
end;

{Returns the comments in a file with documentation as help of a GUI.
~param Text the content of the file to be returned as a comment
~result the documentation of the GUI as a comment }
function TSourceCommentExtractor.GUIHelpDocumentation(Text: String): TComment;
begin
 if FRemoveTrailingWhiteSpaces then  //trailing whitespaces in the lines
  Text := StripTrailingWhiteSpaces(Text);                //must be stripped?
 if FTransformTabToSpaces then       //tabulator characters must be transformed
  Text := TransformTabulators(Text, FTabulatorWidth);    //to spaces?

 Result := Sectionize(Text, True);        //just sectionize it
end;













{Removes leading stars at the beginning of the text and each line of it.
~param Text the text to remove the leading stars from
~result the text without leading stars }
function TSourceCommentExtractor.RemoveLeadingStars(Text: String): String;
var      p            :PChar;         //runner through the string
         Line         :String;        //each line in the text
begin
 if Text <> '' then                   //text not empty?
  begin
   Result := GetLine(Text);             //get first line
   if Result <> '' then                 //line not empty?
    begin
     p := Pointer(Result);
     while p^ = '*' do                    //skip all stars
      Inc(p);
     Delete(Result, 1, Integer(p) - Integer(Pointer(Result))); //delete them
    end;
   if Result <> '' then                 //if line not empty now
    Result := Result + #13#10;            //add it

   while Text <> '' do                  //for each line in the text
    begin
     Line := GetLine(Text);               //get the line
     if Line <> '' then                   //line not empty?
      begin
       p := Pointer(Line);
       while p^ = '*' do                    //skip all stars
        Inc(p);
       Delete(Line, 1, Integer(p) - Integer(Pointer(Line))); //and delete them
      end;
     Result := Result + Line + #13#10;    //add the line
    end;

   Delete(Result, Length(Result) - 1, 2); //remove the final new line

   Result := TrimLeft(Result);            //remove useless whitespaces
  end
 else
  Result := '';                         //just return the empty text
end;


{Removes trailing stars at the end of the text.
~param Text the text to remove the trailing stars from
~result the text without trailing stars }
function TSourceCommentExtractor.RemoveTrailingStars(const Text: String):
                                                                        String;
var      Start        :PChar;       //pointer to the text
         p            :PChar;       //runner through the text
begin
 if Text <> '' then                 //if text not empty
  begin
   Start := Pointer(Text);            //get start of text
   p := Start;
   inc(p, Length(Text) - 1);          //go to the end of text

   //while stars (or whitespaces) and not start reached
   while (p^ in [#0..' ', '*']) and (p <> Start) do
    Dec(p);                             //skip backwards
   if not (p^ in [#0..' ', '*']) then //not a star (or whitespace)?
    Inc(p);                             //don't delete this character

   if p^ <> #0 then                   //some characters skipped?
    //delete them from the text
    Result := TrimRight(Copy(Result, 1, Integer(p) - Integer(Start)))
   else
    Result := Text;                     //just return the text
  end
 else
  Result := '';                    //just return the empty text
end;







{Returns the comments of the identifier or file.
~param Text the text of the comment
~result the processed comment }
function TSourceCommentExtractor.ProcessComment(Text: String): TComment;

 {Checks whether the comment starts with a star '*', possibly after
  whitespaces.
 ~param Text the text to check, must not be empty
 ~result whether the text starts with a star }
 function CheckStar(const Text: String): Boolean;
 var      p        :PChar;       //runner through the text
 begin
  Assert(Text <> '');
//  Result := Copy(TrimLeft(Text), 1, 1) = '*';

  p := Pointer(Text);
  while p^ in [#1..#32] do       //skip all whitespaces
   Inc(p);
  Result := p^ = '*';            //first character is a star?
 end;

 {Checks whether the comment starts with the defined marker, possibly after
  whitespaces. The marker will be removed from the text if it starts with it.
 ~param Text the text to check, must not be empty; out: the text without a
             marker (if it exists)
 ~result whether the text starts with a marker if that is necessary and is not
         empty after removing it }
 function CheckMarker(var Text: String): Boolean;
 var      p          :PChar;       //runner through the text
          pm         :PChar;       //runner through the marker
 begin
  Assert(Text <> '');
  Assert(FCommentMarkerAction <> cmaNoMarker);
  Assert(FCommentMarker <> '');

  p := Pointer(Text);
  if FCommentMarkerAfterWhiteSpace then //white spaces before marker allowed?
   while p^ in [#1..#32] do               //skip all whitespaces
    Inc(p);

  pm := Pointer(FCommentMarker);
  while (p^ = pm^) and (pm^ <> #0) do   //compare the text with the marker
   begin
    Inc(p);
    Inc(pm);
   end;

  if pm^ = #0 then                      //contains the marker?
   begin
    while p^ in [#1..#32] do              //skip following whitespaces
     Inc(p);
    Delete(Text, 1, p - Pointer(Text));   //delete marker and whitespaces
   end;

  //returns whether the comment is valid and not empty
  Result := ((FCommentMarkerAction = cmaUseAllRemoveMarker) or (pm^ = #0)) and
            (Text <> '');
 end;


{$IFNDEF NOREGULAREXPRESSIONS}

 {Extract content of comment from each line by pattern.
 ~param Text the comment to filter
 ~result the content of the comment }
 function CheckEachLine(const Text: String): String;
 var      Lines   :TStringList;        //the lines of the text
          i       :Integer;            //counter through lines
 begin
  Lines := TStringList.Create;         //create object to extract lines
  try
    Lines.Text := Text;                //this text has to be filtered
    for i := 0 to Lines.Count - 1 do   //for each line match the pattern
     if FCommentRegExprPerLineFilter.Exec(Lines[i]) then //and extract content
      Lines[i] := FCommentRegExprPerLineFilter.Match[
                                            FCommentRegExprPerLineContentIndex]
     else
      Lines[i] := '';

    Result := Trim(Lines.Text);        //remove useless lines and whitespaces
  finally
   Lines.Free;
  end;
 end;

{$ENDIF}

begin
 //must start with a star and does not?
 if (Text = '') or (FUseOnlyStaredComments and not CheckStar(Text)) then
  Text := ''                         //no (valid) comment found!
 else
  begin
   //if it has to be checked to contain a marker or at least the marker must be
   //removed, do this first
   if (FCommentMarkerAction <> cmaNoMarker) and (FCommentMarker <> '') and
      not CheckMarker(Text) then
    Text := ''                           //no valid comment found!
   else
    begin

     if FRemoveTrailingWhiteSpaces then  //trailing whitespaces in the lines
      Text := StripTrailingWhiteSpaces(Text);              //must be stripped?

     if FRemoveLeadingStars then         //leading stars should be deleted?
      Text := RemoveLeadingStars(TrimLeftMargin(Text));    //delete them

     if FRemoveTrailingStars then        //trailing stars should be deleted?
      Text := RemoveTrailingStars(Text);                   //delete them

     Text := TrimLeftMargin(TrimLeft(Text));   //delete a possibly used margin


{$IFNDEF NOREGULAREXPRESSIONS}
     //content of the comment should be extracted by pattern?
     if FCommentRegExprContentIndex > 0 then
      //try to find content, found?
      if FCommentRegExprFilter.Exec(Text) then
       //use the content
       Text := FCommentRegExprFilter.Match[FCommentRegExprContentIndex]
      else
       Text := '';                           //no comment

     //comment found and each line should be filtered in turn by a pattern?
     if (Text <> '') and (FCommentRegExprPerLineContentIndex > 0) then
      Text := CheckEachLine(Text);        //extract content from each line
{$ENDIF}

    end;
  end;

 Result := Sectionize(Text, False); //split the text into sections
end;














{$IFOPT C+}
//var    TmpGenerator: TCommentDoc;
{$ENDIF}

initialization
(*
{$IFOPT C+}
 //generate warning, if class is abstract
{$WARNINGS OFF}
 TmpGenerator := TCommentDoc.Create;
{$WARNINGS ON}
 try
   TSourceCommentExtractor.Create(TmpGenerator).Destroy;
 finally
  TmpGenerator.Free;
 end;
{$ENDIF}
*)

 //create enumeration type of options and add their values
 CommentMarkerActionEnumerationList := TStringList.Create;
 CommentMarkerActionEnumerationList.Append('no marker');
 CommentMarkerActionEnumerationList.Append('use only marked comments');
 CommentMarkerActionEnumerationList.Append('use all, but remove markers');


 //register extractor class
 AddCommentExtractorClass(TSourceCommentExtractor);


finalization
 //free enumeration type of options
 CommentMarkerActionEnumerationList.Free;

end.