usinglefileparser.pas

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

const     TopWordsFunctions = [1, 3, 4, 8, 12];
//reserved word for exporting of identifiers
//4: exports
const     TopWordsExports = 6;
//all reserved words, that end the file/a part of the file
//6: interface, implementation, initialization, finalization, begin, end.
const     TopWordsFileParts = [0, 5, 7, 9, 10, 11];
//all reserved words, that end the file
//4: initialization, finalization, begin, end.
const     TopWordsFileEnds = TopWordsFileParts - [9, 11];


          //list of possible kinds of declarations
type      TDefType = (
            dtNone,             //no kind of declarations set
            dtType,             //type declarations follow
            dtResString,        //resource strings follow
            dtConst,            //constants follow
            dtVar,              //variables follow
            dtThreadVar);       //thread variables follow

var       DefType          :TDefType;  //current kind of declarations
          //number of identifiers when a new block of type declarations is
          TypeStartIndex   :Integer;   //started (for forward references)

 {Changes the kind of following declarations. Handles the parsing of forward
  references when a block of type declarations is started or ended
 ~param NewDefType the new kind of declarations }
 procedure ChangeDefType(NewDefType: TDefType);
 begin
  if DefType = dtType then                 //old kind was type?
   TypeBlockHasEnded(TypeStartIndex);        //parse the block
  DefType := NewDefType;                   //set new kind
  if DefType = dtType then                 //new kind is type?
   TypeStartIndex := FActualIdents.Count;    //save number of identifiers
 end;


var       Token            :String;        //a token
          Index            :Integer;       //index of token in array TopWords
          //if the end of the content that should be parsed has been reached
          Finished         :Boolean;

          BeforeStartIndex :Integer;       //the number of declared identifiers

          IsClassFunc      :Boolean;       //class function found?
          FunctionKind     :TFunctionKind; //kind of function found
begin
 FActualIdents := FThisFile.Idents;        //add identifiers to the globals
 FActualScopeIdents := FActualIdents;      //also enumeration items
 DefType := dtNone;                        //no kind of declaration set

 BeforeStartIndex := FActualIdents.Count;  //save number of identifiers

 Finished := False;
 while not Finished and GetToken(Token) do //while the end has not been reached
  begin
   if IsWordIn(Token, TopWords, Index) then  //found a reserved word?
    begin
     if Index in TopWordsDeclType then        //sets the kind of declarations?
      case Index of
        2:   ChangeDefType(dtConst);
        13:  ChangeDefType(dtResString);
        14:  ChangeDefType(dtThreadVar);
        15:  ChangeDefType(dtType);
        17:  ChangeDefType(dtVar);
      else
        raise SysUtils.Exception.CreateFmt('Invalid Word-Index: %d; change and recompile DelphiDoc!',
                                           [Index]);
      end
     else
      begin
       ChangeDefType(dtNone);                 //no declarations follow
       if Index in TopWordsFunctions then     //function declaration?
        begin
         IsClassFunc := Index = 1;              //is a class function?
         if IsClassFunc then
          if not GetToken(Token) or not IsWordIn(Token, TopWords, Index) or
             not (Index in [8, 12]) then          //get next token
           Exception(etSyntax,
                     'Expected "function" or "procedure" after "class"; failed!');

         case Index of                          //set kind of function
           3:   FunctionKind := fkConstructor;
           4:   FunctionKind := fkDestructor;
           8:   FunctionKind := fkFunction;
           12:  FunctionKind := fkProcedure;
         else
           raise SysUtils.Exception.CreateFmt('Invalid Word-Index: %d; change and recompile DelphiDoc!', [Index]);
         end;

         if not InterfacePart then
          begin
           AfterDefinition(BeforeStartIndex);   //parse all new identifiers
           BeforeStartIndex := FActualIdents.Count;
          end;

         //parse the function
         ParseFunction(FunctionKind, IsClassFunc, FScope = sInterface);


         if not InterfacePart then
          begin
           AfterDefinition(BeforeStartIndex);   //parse all new identifiers
           BeforeStartIndex := FActualIdents.Count;
          end;

         SkipSemicolon;
        end
       else
        if Index = TopWordsExports then         //is export clause?
         ParseExportsClause
        else
         if Index in TopWordsFileParts then //end of a part of the file reached?
          begin
           if Index = 9 then                  //implementation found?
            begin
             FScope := sImplementation;       //set scope
             //save position
             FThisFile.ImplementationStart := AbsoluteLastTokenStartPos;
             TestReadUsesClause(fpMain);      //read implementation uses-clause
             Finished := True;                //and finish parsing (this part)
            end
           else
            if Index in TopWordsFileEnds then //end/begin/initialization found
             begin
              //parse everything after initialization, finalization or begin
              if Index <> 5 then
               begin
                AfterDefinition(BeforeStartIndex); //parse all new identifiers
                BeforeStartIndex := FActualIdents.Count;
                ParseEndOfFileSections(Token);     //parse up to the end.
               end;
              //the end has to be followed by the final .
              if not GetToken(Token) or (Token <> '.') then
               Exception(etSyntax,
                         '"." after "end" expected at end of file, failed!');
              Finished := True;               //and finish parsing the file
              if GetToken(Token) then
               WarningMessage(etSyntax, 'Tokens found after final "end."!');
             end;
          end
         else
          if Index = 16 then                  //uses found?
           Exception(etSyntax,
                     '"uses" found not at the beginning of the part of the file.')
          else
           raise SysUtils.Exception.CreateFmt('Invalid Word-Index: %d; change and recompile DelphiDoc!',
                                              [Index]);
      end;
    end
   else
    begin
     case DefType of                                //an identifier is declared
      dtType:      Token := ParseTypeIdentifier(Token);
      dtResString: Token := ParseResourceString(Token);
      dtConst:     Token := ParseConstant(Token);
      dtVar,
      dtThreadVar: Token := ParseVariable(Token, DefType = dtThreadVar);
     else
      Exception(etSyntax,
                'Unknown word "' + Token + '" or identifier not in a declaration block!');
     end;
     if Token <> ';' then
      Exception(etSyntax, '";" expected after declaration, failed');
    end;
  end;
 if not InterfacePart then
  AfterDefinition(BeforeStartIndex);         //parse all new identifiers

{$IFOPT C+}
 assert(PositionStackEmpty);
{$ENDIF}
end;























{Recognizes the kind of the file and parses the first uses clause. If it is a
 package ~[link DoParsePackage] is called to parse the whole file. }
procedure TSingleFileParser.ParseFirstUsesClause;
var       Token            :String;        //a token
          FileName         :String;        //name of the file
          Index            :Integer;       //index of the word
          BothClauses      :TUsesClauses;  //to set the uses clauses
begin
 DoCheckParseState(psUninitialized);  //check if correct state of parsing

 PushPosition;                        //save position in case no kind of file
 if not GetToken(Token) then
  ExceptionAtStart(etSyntax, 'File to parse is empty!');

 if IsWordIn(Token, FileStartWords, Index) then //kind of file specified?
  begin
   LosePosition;                        //delete saved position
   //set kind of file
   FThisFile.FileType := FileStartWordTypes[TSourceFileType(Index)];

   //get internal name of the file
   if not GetIdentWithPointsToken(FileName) { or
      not IsValidIdentifierName(FileName)   } then
    Exception(etSyntax,
              'Missing or invalid name of file after "' + Token + '"!');

   FThisFile.InternalFileName := FileName;

   if FThisFile.FileType = sftUnit then //is a unit?
    begin
     Token := LowerCase(FileName);
     BothClauses := FThisFile.UsesClauses;
     if Token = 'system' then             //check, if it is a default unit
//      BothClauses[fpInterface] := 'SysInit , '
     else
      if Token = 'sysinit' then
       BothClauses[fpInterface] := 'System , '
      else
       //add the default units to the uses clause
       BothClauses[fpInterface] := 'System , SysInit , ';
     FThisFile.UsesClauses := BothClauses;
    end
   else
    if FThisFile.FileType <> sftPackage then  //is a program or library?
     begin
      BothClauses := FThisFile.UsesClauses;
      //add the units to the uses clause
      BothClauses[fpInterface] := 'System , SysInit , ';
      FThisFile.UsesClauses := BothClauses;
     end;


   PushPosition;                         //save current position
   Token := ReadOwnPortabilityIssues;    //read portability issues
   if Token = '(' then                   //parameters for program?
    begin
     PopPosition;                          //return to position

     if FThisFile.FileType <> sftProgram then //is a program?
      WarningMessage(etSyntax,
                     'Parameters found for file, but is no program!');

     repeat                                //skip all directives
       GetBalancedToken(Token);             //and read the parameters
       assert(Token <> '');
     until Token[1] = '(';

     FThisFile.ProgramParameters := Token; //save parameters

     Token := ReadOwnPortabilityIssues;    //read following directives
    end
   else
    LosePosition;

   if Token <> ';' then
    Exception(etSyntax, 'Expected ";" after first statement of the file!');

  end
 else                                 //no type of file given
  begin
   FThisFile.FileType := sftProgram;    //it's a program
   //internal name (seems to be the default)
   FThisFile.InternalFileName := 'program';

   PopPosition;                         //restore save position

   BothClauses := FThisFile.UsesClauses;
   //add the units to the uses clause
   BothClauses[fpInterface] := 'System , SysInit , ';
   FThisFile.UsesClauses := BothClauses;
  end;


 if FThisFile.FileType = sftPackage then     //if it is a package
  DoParsePackage                               //parse it
 else
  if FThisFile.FileType = sftUnit then         //if it is a unit
   begin                                         //read interface
    if not GetToken(Token) or (LowerCase(Token) <> 'interface') then
     Exception(etSyntax, 'Expected "interface" at start of "unit"-file!');
    FScope := sInterface;                        //set scope

    PreParseThisUnit;                            //before parsing it ...
    TestReadUsesClause(fpInterface);             //read the uses-clause
   end
  else
   begin
    FScope := sImplementation;                   //set default scope
    TestReadUsesClause(fpMain);                  //read the uses-clause
   end;
 FGlobalScope := FScope;                     //set also the global scope

 FParseState := psInterfaceUsesClauseParsed; //set new state of parsing
end;


{The interface section is parsed if it is a unit. Nothing is done if it is not
 a unit.}
procedure TSingleFileParser.ParseInterface;
begin
 DoCheckParseState(psInterfaceUnitsParsed); //check if correct state of parsing

 if FThisFile.FileType = sftUnit then       //it is a unit?
  DoParseFile(True);                  //parse the interface-section of the unit

 FParseState := psInterfaceParsed;          //set new state of parsing
end;

{Parses the implementation section of units and the contents of program or
 library files. If it is a package nothing is done. }
procedure TSingleFileParser.ParseImplementations;
begin
 //check if correct state of parsing
 DoCheckParseState(psInterfaceClassHierarchyChecked);

 //if it is a package, it has already been parsed completely
 if FThisFile.FileType <> sftPackage then   //if it is not,
  DoParseFile(False);              //parse the code in the remnant of the file

 FParseState := psImplementationParsed;     //set new state of parsing
end;


{Checks if correct state while parsing and raises an error if not. This is
 more like a debug check.
~param DemandedState the state the parsing should have reached at the moment
~exception SysUtils.Exception if the state should be checked and doesn't match
                              the demanded state }
procedure TSingleFileParser.DoCheckParseState(DemandedState: TParseState);
begin
 //should be checked, and is not correct state?
 if FCheckParseState and (DemandedState <> FParseState) then
  //raise this error
  raise SysUtils.Exception.CreateFmt('DelphiDoc internal error! Change and recompile DelphiDoc: Invalid state while parsing: expected %d, is %d!',
                                     [ord(DemandedState), ord(FParseState)]);
end;


end.