--- Merging r31366 into '.':

U    utils/fpdoc/fpdocclasstree.pp
U    utils/fpdoc/dglobals.pp
U    utils/fpdoc/fpclasschart.pp
--- Recording mergeinfo for merge of r31366 into '.':
 U   .
--- Merging r31367 into '.':
G    utils/fpdoc/fpclasschart.pp
G    utils/fpdoc/fpdocclasstree.pp
--- Recording mergeinfo for merge of r31367 into '.':
 G   .
--- Merging r32183 into '.':
U    packages/fcl-passrc/tests/tcstatements.pas
U    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r32183 into '.':
 G   .
--- Merging r32360 into '.':
U    utils/fpdoc/fpdoc.css
U    utils/fpdoc/css.inc
--- Recording mergeinfo for merge of r32360 into '.':
 G   .
--- Merging r32374 into '.':
U    utils/fpdoc/dw_html.pp
U    utils/fpdoc/mkfpdoc.pp
G    utils/fpdoc/dglobals.pp
U    utils/fpdoc/fpdoc.pp
--- Recording mergeinfo for merge of r32374 into '.':
 G   .
--- Merging r32376 into '.':
A    utils/fpdoc/examples
A    utils/fpdoc/examples/gentest.sh
A    utils/fpdoc/examples/project
A    utils/fpdoc/examples/project/sample-project.xml
A    utils/fpdoc/examples/project/readme.txt
A    utils/fpdoc/examples/basedir
A    utils/fpdoc/examples/basedir/readme.txt
A    utils/fpdoc/examples/basedir/sample-project.xml
A    utils/fpdoc/examples/simple
A    utils/fpdoc/examples/simple/testunit.xml
A    utils/fpdoc/examples/simple/html.bat
A    utils/fpdoc/examples/simple/readme.txt
A    utils/fpdoc/examples/simple/html.sh
A    utils/fpdoc/examples/simple/testunit.pp
D    utils/fpdoc/testunit.pp
D    utils/fpdoc/testunit.xml
D    utils/fpdoc/gentest.sh
--- Recording mergeinfo for merge of r32376 into '.':
 G   .
--- Recording mergeinfo for merge of r34113 into '.':
 G   .
--- Merging r34114 into '.':
U    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r34114 into '.':
 G   .
--- Merging r34132 into '.':
G    packages/fcl-passrc/src/pscanner.pp
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r34132 into '.':
 G   .
--- Merging r34169 into '.':
G    packages/fcl-passrc/src/pscanner.pp
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r34169 into '.':
 G   .

# revisions: 31366,31367,32183,32360,32374,32376,34113,34114,34132,34169

git-svn-id: branches/fixes_3_0@35971 -

.gitattributes

@@ -15449,6 +15449,16 @@ utils/fpdoc/dw_txt.pp svneol=native#text/plain
 utils/fpdoc/dw_xml.pp svneol=native#text/plain
 utils/fpdoc/dwlinear.pp svneol=native#text/plain
 utils/fpdoc/dwriter.pp svneol=native#text/plain
+utils/fpdoc/examples/basedir/readme.txt svneol=native#text/plain
+utils/fpdoc/examples/basedir/sample-project.xml svneol=native#text/plain
+utils/fpdoc/examples/gentest.sh svneol=native#text/plain
+utils/fpdoc/examples/project/readme.txt svneol=native#text/plain
+utils/fpdoc/examples/project/sample-project.xml svneol=native#text/plain
+utils/fpdoc/examples/simple/html.bat svneol=native#text/plain
+utils/fpdoc/examples/simple/html.sh svneol=native#text/plain
+utils/fpdoc/examples/simple/readme.txt svneol=native#text/plain
+utils/fpdoc/examples/simple/testunit.pp svneol=native#text/plain
+utils/fpdoc/examples/simple/testunit.xml svneol=native#text/plain
 utils/fpdoc/fpclasschart.lpi svneol=native#text/plain
 utils/fpdoc/fpclasschart.pp svneol=native#text/plain
 utils/fpdoc/fpde/Makefile svneol=native#text/plain
@@ -15490,7 +15500,6 @@ utils/fpdoc/fpdocstripper.lpi svneol=native#text/plain
 utils/fpdoc/fpdocstripper.pp svneol=native#text/plain
 utils/fpdoc/fpdocxmlopts.pas svneol=native#text/plain
 utils/fpdoc/fpmake.pp svneol=native#text/plain
-utils/fpdoc/gentest.sh svneol=native#text/plain
 utils/fpdoc/images/minus.png -text svneol=unset#image/png
 utils/fpdoc/images/plus.png -text svneol=unset#image/png
 utils/fpdoc/intl/Makefile svneol=native#text/plain
@@ -15511,8 +15520,6 @@ utils/fpdoc/mkfpdocproj.pp svneol=native#text/plain
 utils/fpdoc/plusimage.inc svneol=native#text/plain
 utils/fpdoc/sample-project.xml svneol=native#text/plain
 utils/fpdoc/sh_pas.pp svneol=native#text/plain
-utils/fpdoc/testunit.pp svneol=native#text/plain
-utils/fpdoc/testunit.xml svneol=native#text/plain
 utils/fpdoc/unitdiff.pp svneol=native#text/plain
 utils/fpgmake/fpgmake.pp svneol=native#text/plain
 utils/fpgmake/fpmake.cft svneol=native#text/plain

packages/fcl-passrc/src/pparser.pp

@@ -23,6 +23,53 @@ interface
 
 uses SysUtils, Classes, PasTree, PScanner;
 
+// message numbers
+const
+  nErrNoSourceGiven = 2001;
+  nErrMultipleSourceFiles = 2002;
+  nParserError = 2003;
+  nParserErrorAtToken = 2004;
+  nParserUngetTokenError = 2005;
+  nParserExpectTokenError = 2006;
+  nParserForwardNotInterface = 2007;
+  nParserExpectVisibility = 2008;
+  nParserStrangeVisibility = 2009;
+  nParserExpectToken2Error = 2010;
+  nParserExpectedCommaRBracket = 2011;
+  nParserExpectedCommaSemicolon = 2012;
+  nParserExpectedAssignIn = 2013;
+  nParserExpectedCommaColon = 2014;
+  nErrUnknownOperatorType = 2015;
+  nParserOnlyOneArgumentCanHaveDefault = 2016;
+  nParserExpectedLBracketColon = 2017;
+  nParserExpectedSemiColonEnd = 2018;
+  nParserExpectedConstVarID = 2019;
+  nParserExpectedNested = 2020;
+  nParserExpectedColonID = 2021;
+  nParserSyntaxError = 2022;
+  nParserTypeSyntaxError = 2023;
+  nParserArrayTypeSyntaxError = 2024;
+  nParserExpectedIdentifier = 2026;
+  nParserNotAProcToken = 2026;
+  nRangeExpressionExpected = 2027;
+  nParserExpectCase = 2028;
+  nParserHelperNotAllowed = 2029;
+  nLogStartImplementation = 2030;
+  nLogStartInterface = 2031;
+  nParserNoConstructorAllowed = 2032;
+  nParserNoFieldsAllowed = 2033;
+  nParserInvalidRecordVisibility = 2034;
+  nErrRecordConstantsNotAllowed = 2035;
+  nErrRecordMethodsNotAllowed = 2036;
+  nErrRecordPropertiesNotAllowed = 2037;
+  nErrRecordVisibilityNotAllowed = 2038;
+  nParserTypeNotAllowedHere = 2039;
+  nParserNotAnOperand = 2040;
+  nParserArrayPropertiesCannotHaveDefaultValue = 2041;
+  nParserDefaultPropertyMustBeArray = 2042;
+  nParserUnknownProcedureType = 2043;
+
+// resourcestring patterns of messages
 resourcestring
   SErrNoSourceGiven = 'No source file specified';
   SErrMultipleSourceFiles = 'Please specify only one source file';
@@ -62,6 +109,11 @@ resourcestring
   SErrRecordMethodsNotAllowed = 'Record methods not allowed at this location.';
   SErrRecordPropertiesNotAllowed = 'Record properties not allowed at this location.';
   SErrRecordVisibilityNotAllowed = 'Record visibilities not allowed at this location.';
+  SParserTypeNotAllowedHere = 'Type "%s" not allowed here';
+  SParserNotAnOperand = 'Not an operand: (%d : %s)';
+  SParserArrayPropertiesCannotHaveDefaultValue = 'Array properties cannot have default value';
+  SParserDefaultPropertyMustBeArray = 'The default property must be an array property';
+  SParserUnknownProcedureType = 'Unknown procedure type "%d"';
 
 type
   TPasParserLogHandler = Procedure (Sender : TObject; Const Msg : String) of object;
@@ -128,6 +180,12 @@ type
   private
     FCurModule: TPasModule;
     FFileResolver: TBaseFileResolver;
+    FImplicitUses: TStrings;
+    FLastMsg: string;
+    FLastMsgArgs: TMessageArgs;
+    FLastMsgNumber: integer;
+    FLastMsgPattern: string;
+    FLastMsgType: TMessageType;
     FLogEvents: TPParserLogEvents;
     FOnLog: TPasParserLogHandler;
     FOptions: TPOptions;
@@ -158,8 +216,8 @@ type
     Function SaveComments : String;
     Function SaveComments(Const AValue : String) : String;
     function LogEvent(E : TPParserLogEvent) : Boolean; inline;
-    Procedure DoLog(Const Msg : String; SkipSourceInfo : Boolean = False);overload;
-    Procedure DoLog(Const Fmt : String; Args : Array of const;SkipSourceInfo : Boolean = False);overload;
+    Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Msg : String; SkipSourceInfo : Boolean = False);overload;
+    Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Fmt : String; Args : Array of const;SkipSourceInfo : Boolean = False);overload;
     function GetProcTypeFromToken(tk: TToken; IsClass: Boolean=False ): TProcType;
     procedure ParseRecordFieldList(ARec: TPasRecordType; AEndToken: TToken; AllowMethods : Boolean);
     procedure ParseRecordVariantParts(ARec: TPasRecordType; AEndToken: TToken);
@@ -170,8 +228,11 @@ type
     procedure ReadGenericArguments(List : TFPList;Parent : TPasElement);
     function CheckProcedureArgs(Parent: TPasElement; Args: TFPList; Mandatory: Boolean): boolean;
     function CheckVisibility(S: String; var AVisibility: TPasMemberVisibility): Boolean;
-    procedure ParseExc(const Msg: String);
-    procedure ParseExc(const Fmt: String; Args : Array of const);
+    procedure ParseExc(MsgNumber: integer; const Msg: String);
+    procedure ParseExc(MsgNumber: integer; const Fmt: String; Args : Array of const);
+    procedure ParseExcExpectedIdentifier;
+    procedure ParseExcSyntaxError;
+    procedure ParseExcTokenError(const Arg: string);
     function OpLevel(t: TToken): Integer;
     Function TokenToExprOp (AToken : TToken) : TExprOpCode;
     function CreateElement(AClass: TPTreeElement; const AName: String; AParent: TPasElement): TPasElement;overload;
@@ -195,6 +256,7 @@ type
   public
     constructor Create(AScanner: TPascalScanner; AFileResolver: TBaseFileResolver;  AEngine: TPasTreeContainer);
     Destructor Destroy; override;
+    procedure SetLastMsg(MsgType: TMessageType; MsgNumber: integer; Const Fmt : String; Args : Array of const);
     // General parsing routines
     function CurTokenName: String;
     function CurTokenText: String;
@@ -262,6 +324,12 @@ type
     Property CurModule : TPasModule Read FCurModule;
     Property LogEvents : TPParserLogEvents Read FLogEvents Write FLogEvents;
     Property OnLog : TPasParserLogHandler Read FOnLog Write FOnLog;
+    property ImplicitUses: TStrings read FImplicitUses;
+    property LastMsg: string read FLastMsg write FLastMsg;
+    property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
+    property LastMsgType: TMessageType read FLastMsgType write FLastMsgType;
+    property LastMsgPattern: string read FLastMsgPattern write FLastMsgPattern;
+    property LastMsgArgs: TMessageArgs read FLastMsgArgs write FLastMsgArgs;
   end;
 
 function ParseSource(AEngine: TPasTreeContainer;
@@ -546,16 +614,34 @@ end;
   TPasParser
   ---------------------------------------------------------------------}
 
-procedure TPasParser.ParseExc(const Msg: String);
+procedure TPasParser.ParseExc(MsgNumber: integer; const Msg: String);
 begin
-  raise EParserError.Create(Format(SParserErrorAtToken, [Msg, CurTokenName, Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn])
+  ParseExc(MsgNumber,Msg,[]);
+end;
+
+procedure TPasParser.ParseExc(MsgNumber: integer; const Fmt: String;
+  Args: array of const);
+begin
+  SetLastMsg(mtError,MsgNumber,Fmt,Args);
+  raise EParserError.Create(Format(SParserErrorAtToken,
+    [FLastMsg, CurTokenName, Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn])
     {$ifdef addlocation}+' ('+inttostr(scanner.currow)+' '+inttostr(scanner.curcolumn)+')'{$endif},
     Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn);
 end;
 
-procedure TPasParser.ParseExc(const Fmt: String; Args: array of const);
+procedure TPasParser.ParseExcExpectedIdentifier;
 begin
-  ParseExc(Format(Fmt,Args));
+  ParseExc(nParserExpectedIdentifier,SParserExpectedIdentifier);
+end;
+
+procedure TPasParser.ParseExcSyntaxError;
+begin
+  ParseExc(nParserSyntaxError,SParserSyntaxError);
+end;
+
+procedure TPasParser.ParseExcTokenError(const Arg: string);
+begin
+  ParseExc(nParserExpectTokenError,SParserExpectTokenError,[Arg]);
 end;
 
 constructor TPasParser.Create(AScanner: TPascalScanner;
@@ -573,10 +659,13 @@ begin
     If FEngine.NeedComments then
       FScanner.SkipComments:=Not FEngine.NeedComments;
     end;
+  FImplicitUses := TStringList.Create;
+  FImplicitUses.Add('System'); // system always implicitely first.
 end;
 
 destructor TPasParser.Destroy;
 begin
+  FreeAndNil(FImplicitUses);
   FreeAndNil(FCommentsBuffer[0]);
   FreeAndNil(FCommentsBuffer[1]);
   if Assigned(FEngine) then
@@ -666,7 +755,7 @@ procedure TPasParser.UngetToken;
 
 begin
   if FTokenBufferIndex = 0 then
-    ParseExc(SParserUngetTokenError)
+    ParseExc(nParserUngetTokenError,SParserUngetTokenError)
   else begin
     Dec(FTokenBufferIndex);
     if FTokenBufferIndex>0 then
@@ -686,7 +775,7 @@ end;
 procedure TPasParser.CheckToken(tk: TToken);
 begin
   if (CurToken<>tk) then
-    ParseExc(Format(SParserExpectTokenError, [TokenInfos[tk]]));
+    ParseExcTokenError(TokenInfos[tk]);
 end;
 
 
@@ -789,7 +878,7 @@ begin
      begin
      NextToken;
      if Not (CurToken in [tkArray, tkRecord, tkObject, tkClass]) then
-       ParseExc(Format(SParserExpectTokenError,['ARRAY, RECORD, OBJECT or CLASS']))
+       ParseExcTokenError('ARRAY, RECORD, OBJECT or CLASS');
      end;
 end;
 
@@ -976,10 +1065,10 @@ begin
         if CurToken = tkBraceClose then
           Break
         else if not (CurToken=tkComma) then
-          ParseExc(SParserExpectedCommaRBracket);
+          ParseExc(nParserExpectedCommaRBracket,SParserExpectedCommaRBracket);
         end
       else if not (CurToken=tkComma) then
-        ParseExc(SParserExpectedCommaRBracket)
+        ParseExc(nParserExpectedCommaRBracket,SParserExpectedCommaRBracket)
       end;
   except
     FreeAndNil(Result);
@@ -1021,7 +1110,7 @@ begin
     begin
     CH:=False;
     if (CurToken in FullTypeTokens) then
-      ParseExc('Type '+CurtokenText+' not allowed here');
+      ParseExc(nParserTypeNotAllowedHere,SParserTypeNotAllowedHere,[CurtokenText]);
     end;
   Try
     case CurToken of
@@ -1125,7 +1214,7 @@ begin
           end
         end
       else
-        ParseExc(SParserArrayTypeSyntaxError);
+        ParseExc(nParserArrayTypeSyntaxError,SParserArrayTypeSyntaxError);
     end;
   except
     FreeAndNil(Result);
@@ -1231,7 +1320,7 @@ begin
     tkDot                   : Result:=eopSubIdent;
     tkCaret                 : Result:=eopDeref;
   else
-    ParseExc(format('Not an operand: (%d : %s)',[AToken,TokenInfos[AToken]]));
+    ParseExc(nParserNotAnOperand,SParserNotAnOperand,[AToken,TokenInfos[AToken]]);
   end;
 end;
  
@@ -1294,7 +1383,7 @@ begin
       NextToken;
       if (length(CurTokenText)=0) or not (CurTokenText[1] in ['A'..'_']) then begin
         UngetToken;
-        ParseExc(SParserExpectedIdentifier);
+        ParseExcExpectedIdentifier;
       end;
       x:=TPrimitiveExpr.Create(AParent,pekString, '@'+CurTokenText);
     end;
@@ -1303,12 +1392,12 @@ begin
       NextToken;
       if not (length(CurTokenText)=1) or not (CurTokenText[1] in ['A'..'_']) then begin
         UngetToken;
-        ParseExc(SParserExpectedIdentifier);
+        ParseExcExpectedIdentifier;
       end;
       x:=TPrimitiveExpr.Create(AParent,pekString, '^'+CurTokenText);
     end;
   else
-    ParseExc(SParserExpectedIdentifier);
+    ParseExcExpectedIdentifier;
   end;
 
   if x.Kind<>pekSet then NextToken;
@@ -1327,7 +1416,7 @@ begin
         else
           begin
           UngetToken;
-          ParseExc(SParserExpectedIdentifier);
+          ParseExcExpectedIdentifier;
           end;
         x:=b;
         end;
@@ -1547,7 +1636,7 @@ begin
      // Writeln('Bin ',NotBinary ,' or EOE ',isEndOfExp, ' Ex ',Assigned(x),' stack ',ExpStack.Count);
     until NotBinary or isEndOfExp;
 
-    if not NotBinary then ParseExc(SParserExpectedIdentifier);
+    if not NotBinary then ParseExcExpectedIdentifier;
 
     while opstack.Count>0 do PopAndPushOperator;
 
@@ -1639,13 +1728,13 @@ begin
     else
       // Binary expression!  ((128 div sizeof(longint)) - 3);       ;
       Result:=DoParseExpression(AParent,x);
-      if CurToken<>tkBraceClose then ParseExc(SParserExpectedCommaRBracket);
+      if CurToken<>tkBraceClose then ParseExc(nParserExpectedCommaRBracket,SParserExpectedCommaRBracket);
       NextToken;
       if CurToken <> tkSemicolon then // the continue of expresion
         Result:=DoParseExpression(AParent,Result);
       Exit;
     end;
-    if CurToken<>tkBraceClose then ParseExc(SParserExpectedCommaRBracket);
+    if CurToken<>tkBraceClose then ParseExc(nParserExpectedCommaRBracket,SParserExpectedCommaRBracket);
     NextToken;
   end;
 end;
@@ -1745,7 +1834,7 @@ begin
   else
     ungettoken;
     ParseProgram(Module,True);
-  //    ParseExc(Format(SParserExpectTokenError, ['unit']));
+  //    ParseExcTokenError('unit');
   end;
 end;
 
@@ -1777,7 +1866,7 @@ begin
 //    ExpectToken(tkSemicolon);
     ExpectToken(tkInterface);
     If LogEvent(pleInterface) then
-      DoLog(SLogStartInterface );
+      DoLog(mtInfo,nLogStartInterface,SLogStartInterface);
     ParseInterface;
   finally
     FCurModule:=nil;
@@ -1815,14 +1904,14 @@ begin
         PP.InputFile:=ExpectIdentifier;
         NextToken;
         if Not (CurToken in [tkBraceClose,tkComma]) then
-          ParseExc(SParserExpectedCommaRBracket);
+          ParseExc(nParserExpectedCommaRBracket,SParserExpectedCommaRBracket);
         If (CurToken=tkComma) then
           PP.OutPutFile:=ExpectIdentifier;
         ExpectToken(tkBraceClose);
         NextToken;
         end;
       if (CurToken<>tkSemicolon) then
-        ParseExc(Format(SParserExpectTokenError,[';']));
+        ParseExcTokenError(';');
       end;
     Section := TProgramSection(CreateElement(TProgramSection, '', CurModule));
     PP.ProgramSection := Section;
@@ -1850,7 +1939,7 @@ begin
     end;
     NextToken;
     if (CurToken<>tkSemicolon) then
-        ParseExc(Format(SParserExpectTokenError,[';']));
+        ParseExcTokenError(';');
     Section := TLibrarySection(CreateElement(TLibrarySection, '', CurModule));
     PP.LibrarySection := Section;
     ParseDeclarations(Section);
@@ -1964,7 +2053,7 @@ begin
       else
         Result:=ptOperator;
   else
-    ParseExc(SParserNotAProcToken);
+    ParseExc(nParserNotAProcToken,SParserNotAProcToken);
   end;
 end;
 
@@ -1993,7 +2082,7 @@ begin
       tkend:
         begin
         If (CurModule is TPasProgram) and (CurModule.InitializationSection=Nil) then
-          ParseExc(Format(SParserExpectTokenError,['begin']));
+          ParseExcTokenError('begin');
         ExpectToken(tkDot);
         break;
         end;
@@ -2003,7 +2092,7 @@ begin
           If Not Engine.InterfaceOnly then
             begin
             If LogEvent(pleImplementation) then
-              DoLog(SLogStartImplementation);
+              DoLog(mtInfo,nLogStartImplementation,SLogStartImplementation);
             ParseImplementation;
             end;
           break;
@@ -2026,7 +2115,7 @@ begin
         if Declarations is TPasSection then
           ParseUsesList(TPasSection(Declarations))
         else
-          ParseExc(SParserSyntaxError);
+          ParseExcSyntaxError;
       tkConst:
         CurBlock := declConst;
       tkexports:
@@ -2158,13 +2247,13 @@ begin
               Declarations.properties.add(PropEl);
               end;
           else
-            ParseExc(SParserSyntaxError);
+            ParseExcSyntaxError;
           end;
         end;
       tkGeneric:
         begin
           if CurBlock <> declType then
-            ParseExc(SParserSyntaxError);
+            ParseExcSyntaxError;
           TypeName := ExpectIdentifier;
           ClassEl := TPasClassType(Engine.CreateElement(TPasClassType,TypeName,Declarations, Scanner.CurFilename, Scanner.CurRow));
           ClassEl.ObjKind:=okGeneric;
@@ -2196,7 +2285,7 @@ begin
           break;
           end
         else
-          ParseExc(SParserSyntaxError);
+          ParseExcSyntaxError;
         end;
       tklabel:
         begin
@@ -2204,7 +2293,7 @@ begin
             ParseLabels(Declarations);
         end;
     else
-      ParseExc(SParserSyntaxError);
+      ParseExcSyntaxError;
     end;
   end;
 end;
@@ -2226,9 +2315,15 @@ procedure TPasParser.ParseUsesList(ASection: TPasSection);
 var
   AUnitName: String;
   Element: TPasElement;
+  i: Integer;
 begin
   If not (Asection.ClassType=TImplementationSection) Then // interface,program,library,package
-    Element:=CheckUnit('System'); // system always implicitely first.    
+    begin
+    // load implicit units, like 'System'
+    for i:=0 to ImplicitUses.Count-1 do
+      CheckUnit(ImplicitUses[i]);
+    end;
+
   Repeat
     AUnitName := ExpectIdentifier; 
     NextToken;
@@ -2250,7 +2345,7 @@ begin
       end;
 
     if Not (CurToken in [tkComma,tkSemicolon]) then
-      ParseExc(SParserExpectedCommaSemicolon);
+      ParseExc(nParserExpectedCommaSemicolon,SParserExpectedCommaSemicolon);
   Until (CurToken=tkSemicolon);
 end;
 
@@ -2305,8 +2400,8 @@ begin
     List.Add(CreateElement(TPasGenericTemplateType,N,Parent));
     NextToken;
     if not (CurToken in [tkComma, tkGreaterThan]) then
-      ParseExc(Format(SParserExpectToken2Error,
-        [TokenInfos[tkComma], TokenInfos[tkGreaterThan]]));
+      ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
+        [TokenInfos[tkComma], TokenInfos[tkGreaterThan]]);
   until CurToken = tkGreaterThan;
 end;
 
@@ -2323,14 +2418,14 @@ begin
     if Full then
       begin
       If not (CurToken=tkEqual) then
-        ParseExc(Format(SParserExpectTokenError,[TokenInfos[tkEqual]]));
+        ParseExcTokenError(TokenInfos[tkEqual]);
       end;
     NextToken;
     PE:=DoParseExpression(Result,Nil);
     if not ((PE is TBinaryExpr) and (TBinaryExpr(PE).Kind=pekRange)) then
       begin
       FreeAndNil(PE);
-      ParseExc(SRangeExpressionExpected);
+      ParseExc(nRangeExpressionExpected,SRangeExpressionExpected);
       end;
     Result.RangeExpr:=PE as TBinaryExpr;
     UngetToken;
@@ -2362,7 +2457,7 @@ begin
       E.ExportName:=DoParseExpression(E,Nil)
       end;
     if not (CurToken in [tkComma,tkSemicolon]) then
-      ParseExc(SParserExpectedCommaSemicolon);
+      ParseExc(nParserExpectedCommaSemicolon,SParserExpectedCommaSemicolon);
   until (CurToken=tkSemicolon);
 end;
 
@@ -2488,12 +2583,12 @@ begin
         if (CurToken in [tkString,tkIdentifier]) then
           Result := Result + CurTokenText
         else
-          ParseExc(SParserSyntaxError);
+          ParseExcSyntaxError;
         ExportName:=CurTokenText;
         NextToken;
         end
       else
-        ParseExc(SParserSyntaxError);
+        ParseExcSyntaxError;
       end;
     end;
 end;
@@ -2520,7 +2615,7 @@ begin
       VarNames.Add(CurTokenString);
       NextToken;
       if Not (CurToken in [tkComma,tkColon]) then
-        ParseExc(SParserExpectedCommaColon);
+        ParseExc(nParserExpectedCommaColon,SParserExpectedCommaColon);
       if CurToken=tkComma then
         ExpectIdentifier;
     Until (CurToken=tkColon);
@@ -2590,19 +2685,31 @@ begin
   Result:=E in FLogEvents;
 end;
 
-procedure TPasParser.DoLog(const Msg: String; SkipSourceInfo: Boolean);
+procedure TPasParser.SetLastMsg(MsgType: TMessageType; MsgNumber: integer;
+  const Fmt: String; Args: array of const);
 begin
-  If Assigned(FOnLog) then
-    if SkipSourceInfo or not assigned(scanner) then
-      FOnLog(Self,Msg)
-    else
-      FOnLog(Self,Format('%s(%d) : %s',[Scanner.CurFilename,SCanner.CurRow,Msg]));
+  FLastMsgType := MsgType;
+  FLastMsgNumber := MsgNumber;
+  FLastMsgPattern := Fmt;
+  FLastMsg := Format(Fmt,Args);
+  CreateMsgArgs(FLastMsgArgs,Args);
 end;
 
-procedure TPasParser.DoLog(const Fmt: String; Args: array of const;
-  SkipSourceInfo: Boolean);
+procedure TPasParser.DoLog(MsgType: TMessageType; MsgNumber: integer;
+  const Msg: String; SkipSourceInfo: Boolean);
 begin
-  DoLog(Format(Fmt,Args),SkipSourceInfo);
+  DoLog(MsgType,MsgNumber,Msg,[],SkipSourceInfo);
+end;
+
+procedure TPasParser.DoLog(MsgType: TMessageType; MsgNumber: integer;
+  const Fmt: String; Args: array of const; SkipSourceInfo: Boolean);
+begin
+  SetLastMsg(MsgType,MsgNumber,Fmt,Args);
+  If Assigned(FOnLog) then
+    if SkipSourceInfo or not assigned(scanner) then
+      FOnLog(Self,FLastMsg)
+    else
+      FOnLog(Self,Format('%s(%d) : %s',[Scanner.CurFilename,Scanner.CurRow,FLastMsg]));
 end;
 
 procedure TPasParser.ParseInlineVarDecl(Parent: TPasElement; List: TFPList;
@@ -2616,7 +2723,7 @@ begin
   if ClosingBrace then
    include(tt,tkBraceClose);
   if not (CurToken in tt) then
-    ParseExc(SParserExpectedSemiColonEnd);
+    ParseExc(nParserExpectedSemiColonEnd,SParserExpectedSemiColonEnd);
 end;
 
 // Starts after the variable name
@@ -2668,7 +2775,7 @@ begin
         end else if CurToken = tkIdentifier then
           Name := CurTokenString
         else
-          ParseExc(SParserExpectedConstVarID);
+          ParseExc(nParserExpectedConstVarID,SParserExpectedConstVarID);
         ArgNames.Add(Name);
         NextToken;
         if CurToken = tkColon then
@@ -2682,7 +2789,7 @@ begin
           break
         end
         else if CurToken <> tkComma then
-          ParseExc(SParserExpectedCommaColon);
+          ParseExc(nParserExpectedCommaColon,SParserExpectedCommaColon);
       end;
       Value:=Nil;
       if not IsUntyped then
@@ -2695,7 +2802,7 @@ begin
             if (ArgNames.Count>1) then
               begin
               FreeAndNil(ArgType);
-              ParseExc(SParserOnlyOneArgumentCanHaveDefault);
+              ParseExc(nParserOnlyOneArgumentCanHaveDefault,SParserOnlyOneArgumentCanHaveDefault);
               end;
             NextToken;
             Value := DoParseExpression(Parent,Nil);
@@ -2744,7 +2851,7 @@ begin
   if not Result then
     begin
     if Mandatory then
-      ParseExc(SParserExpectedLBracketColon)
+      ParseExc(nParserExpectedLBracketColon,SParserExpectedLBracketColon)
     else
       UngetToken;
     end
@@ -2795,7 +2902,7 @@ begin
           begin
           NextToken;
           if not (CurToken in [tkString,tkIdentifier]) then
-            ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkString]]));
+            ParseExcTokenError(TokenInfos[tkString]);
           E:=DoParseExpression(Parent);
           if Assigned(P) then
             P.LibrarySymbolName:=E;
@@ -2820,19 +2927,19 @@ begin
       begin
       NextToken;  // Should be export name string.
       if not (CurToken in [tkString,tkIdentifier]) then
-        ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkString]]));
+        ParseExcTokenError(TokenInfos[tkString]);
       E:=DoParseExpression(Parent);
       if parent is TPasProcedure then
         TPasProcedure(Parent).PublicName:=E;
       if (CurToken <> tkSemicolon) then
-        ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkSemicolon]]));
+        ParseExcTokenError(TokenInfos[tkSemicolon]);
       end;
     end
   else if (pm=pmForward) then
     begin
     if (Parent.Parent is TInterfaceSection) then
        begin
-       ParseExc(SParserForwardNotInterface);
+       ParseExc(nParserForwardNotInterface,SParserForwardNotInterface);
        UngetToken;
        end;
     end
@@ -2912,7 +3019,7 @@ begin
         if (CurToken=tkColon) then
           TPasFunctionType(Element).ResultEl.Name := 'Result'
         else
-          ParseExc(SParserExpectedColonID);
+          ParseExc(nParserExpectedColonID,SParserExpectedColonID);
         TPasFunctionType(Element).ResultEl.ResultType := ParseType(Parent)
       end;
   end;
@@ -2928,7 +3035,7 @@ begin
       begin
       expectToken(tkIdentifier);
       if (lowerCase(CurTokenString)<>'nested') then
-        ParseExc(SParserExpectedNested);
+        ParseExc(nParserExpectedNested,SParserExpectedNested);
       Element.isNested:=True;
       end
     else
@@ -3109,13 +3216,13 @@ begin
       else if CurToken = tkIdentifier then
         Result.StoredAccessorName := CurTokenString
       else
-        ParseExc(SParserSyntaxError);
+        ParseExcSyntaxError;
       NextToken;
       end;
     if CurTokenIsIdentifier('DEFAULT') then
       begin
       if isArray then
-        ParseExc('Array properties cannot have default value');
+        ParseExc(nParserArrayPropertiesCannotHaveDefaultValue,SParserArrayPropertiesCannotHaveDefaultValue);
       NextToken;
       Result.DefaultExpr := DoParseExpression(Result);
 //      NextToken;
@@ -3131,7 +3238,7 @@ begin
     if CurTokenIsIdentifier('DEFAULT') then
       begin
       if (Result.VarType<>Nil) and (not isArray) then
-        ParseExc('The default property must be an array property');
+        ParseExc(nParserDefaultPropertyMustBeArray,SParserDefaultPropertyMustBeArray);
       NextToken;
       if CurToken = tkSemicolon then
         begin
@@ -3318,7 +3425,7 @@ begin
         TPasImplTry(CurBlock).ElseBranch:=TPasImplTryExceptElse(el);
         CurBlock:=TPasImplTryExceptElse(el);
       end else
-        ParseExc(SParserSyntaxError);
+        ParseExcSyntaxError;
     tkwhile:
       begin
         // while Condition do
@@ -3347,7 +3454,7 @@ begin
         Left:=Nil;
         Right:=Nil;
         if Not (CurToken in [tkAssign,tkIn]) then
-          ParseExc(SParserExpectedAssignIn);
+          ParseExc(nParserExpectedAssignIn,SParserExpectedAssignIn);
         if (CurToken=tkAssign) then
           lt:=ltNormal
         else
@@ -3358,14 +3465,14 @@ begin
           if (Lt=ltNormal) then
             begin
             if Not (CurToken in [tkTo,tkDownTo]) then
-              ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkTo]]));
+              ParseExcTokenError(TokenInfos[tkTo]);
             if CurToken=tkdownto then
               Lt:=ltDown;
             NextToken;
             Right:=DoParseExpression(Parent);
             end;
           if (CurToken<>tkDo) then
-            ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkDo]]));
+            ParseExcTokenError(TokenInfos[tkDo]);
         except
           FreeAndNil(Left);
           FreeAndNil(Right);
@@ -3392,7 +3499,7 @@ begin
         repeat
           if CurToken=tkdo then break;
           if CurToken<>tkComma then
-            ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkdo]]));
+            ParseExcTokenError(TokenInfos[tkdo]);
           NextToken;
           Left:=DoParseExpression(Parent);
           //writeln(i,'WITH ...,Expr="',Expr,'" Token=',CurTokenText);
@@ -3416,7 +3523,7 @@ begin
           tkend:
             begin
             if CurBlock.Elements.Count=0 then
-              ParseExc(SParserExpectCase);
+              ParseExc(nParserExpectCase,SParserExpectCase);
             break; // end without else
             end;
           tkelse:
@@ -3429,24 +3536,33 @@ begin
             end
           else
             // read case values
-            repeat
-              Left:=DoParseExpression(Parent);
-              //writeln(i,'CASE value="',Expr,'" Token=',CurTokenText);
-              if CurBlock is TPasImplCaseStatement then
-                TPasImplCaseStatement(CurBlock).Expressions.Add(Left)
-              else
-                begin
-                el:=TPasImplCaseStatement(CreateElement(TPasImplCaseStatement,'',CurBlock));
-                TPasImplCaseStatement(el).AddExpression(Left);
-                CurBlock.AddElement(el);
-                CurBlock:=TPasImplCaseStatement(el);
-                end;
-              //writeln(i,'CASE after value Token=',CurTokenText);
-              if (CurToken=tkComma) then
-                NextToken
-              else if (CurToken<>tkColon) then
-                ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkComma]]))
-            until Curtoken=tkColon;
+            if (curToken=tkIdentifier) and (LowerCase(CurtokenString)='otherwise') then
+              begin
+              // create case-else block
+              el:=TPasImplCaseElse(CreateElement(TPasImplCaseElse,'',CurBlock));
+              TPasImplCaseOf(CurBlock).ElseBranch:=TPasImplCaseElse(el);
+              CreateBlock(TPasImplCaseElse(el));
+              break;
+              end
+            else
+              repeat
+                Left:=DoParseExpression(Parent);
+                //writeln(i,'CASE value="',Expr,'" Token=',CurTokenText);
+                if CurBlock is TPasImplCaseStatement then
+                  TPasImplCaseStatement(CurBlock).Expressions.Add(Left)
+                else
+                  begin
+                  el:=TPasImplCaseStatement(CreateElement(TPasImplCaseStatement,'',CurBlock));
+                  TPasImplCaseStatement(el).AddExpression(Left);
+                  CurBlock.AddElement(el);
+                  CurBlock:=TPasImplCaseStatement(el);
+                  end;
+                //writeln(i,'CASE after value Token=',CurTokenText);
+                if (CurToken=tkComma) then
+                  NextToken
+                else if (CurToken<>tkColon) then
+                  ParseExcTokenError(TokenInfos[tkComma]);
+              until Curtoken=tkColon;
             // read statement
             ParseStatement(CurBlock,SubBlock);
             CloseBlock;
@@ -3454,7 +3570,7 @@ begin
             begin
               NextToken;
               if not (CurToken in [tkSemicolon,tkelse,tkend]) then
-                ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkSemicolon]]));
+                ParseExcTokenError(TokenInfos[tkSemicolon]);
               if CurToken<>tkSemicolon then
                 UngetToken;
             end;
@@ -3484,7 +3600,7 @@ begin
           TPasImplTry(CurBlock).FinallyExcept:=TPasImplTryFinally(el);
           CurBlock:=TPasImplTryFinally(el);
         end else
-          ParseExc(SParserSyntaxError);
+          ParseExcSyntaxError;
       end;
     tkexcept:
       begin
@@ -3500,7 +3616,7 @@ begin
           TPasImplTry(CurBlock).FinallyExcept:=TPasImplTryExcept(el);
           CurBlock:=TPasImplTryExcept(el);
         end else
-          ParseExc(SParserSyntaxError);
+          ParseExcSyntaxError;
       end;
     tkon:
       begin
@@ -3530,7 +3646,7 @@ begin
           CurBlock:=TPasImplExceptOn(el);
           ExpectToken(tkDo);
         end else
-          ParseExc(SParserSyntaxError);
+          ParseExcSyntaxError;
       end;
     tkraise:
       begin
@@ -3573,7 +3689,7 @@ begin
           if CloseBlock then break; // close try
           if CloseStatement(false) then break;
         end else
-          ParseExc(SParserSyntaxError);
+          ParseExcSyntaxError;
       end;
     tkSemiColon:
       if CloseStatement(true) then break;
@@ -3593,7 +3709,7 @@ begin
           //WriteLn(i,'UNTIL Condition="',Condition,'" Token=',CurTokenString);
           if CloseBlock then break;
         end else
-          ParseExc(SParserSyntaxError);
+          ParseExcSyntaxError;
       end;
     else
       left:=DoParseExpression(nil);
@@ -3619,7 +3735,7 @@ begin
         tkColon:
         begin
           if not (left is TPrimitiveExpr) then
-            ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkSemicolon]]));
+            ParseExcTokenError(TokenInfos[tkSemicolon]);
           // label mark. todo: check mark identifier in the list of labels
           el:=TPasImplLabelMark(CreateElement(TPasImplLabelMark,'', CurBlock));
           TPasImplLabelMark(el).LabelId:=TPrimitiveExpr(left).Value;
@@ -3651,7 +3767,7 @@ begin
     Labels.Labels.Add(ExpectIdentifier);
     NextToken;
     if not (CurToken in [tkSemicolon, tkComma]) then
-      ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkSemicolon]]));
+      ParseExcTokenError(TokenInfos[tkSemicolon]);
   until CurToken=tkSemicolon;
 end;
 
@@ -3671,7 +3787,7 @@ begin
     ptOperator       : Result:=TPasOperator;
     ptClassOperator  : Result:=TPasClassOperator;
   else
-    ParseExc('Unknown procedure Type '+intToStr(Ord(ProcType)));
+    ParseExc(nParserUnknownProcedureType,SParserUnknownProcedureType,[Ord(ProcType)]);
   end;
 end;
 
@@ -3710,7 +3826,7 @@ begin
     else
       OT:=TPasOperator.NameToOperatorType(CurTokenString);
     if (ot=otUnknown) then
-      ParseExc(SErrUnknownOperatorType,[CurTokenString]);
+      ParseExc(nErrUnknownOperatorType,SErrUnknownOperatorType,[CurTokenString]);
     Name:=OperatorNames[Ot];
     end;
   PC:=GetProcedureClass(ProcType);
@@ -3772,7 +3888,7 @@ begin
       NextToken;
       V.Values.Add(DoParseExpression(ARec));
       if Not (CurToken in [tkComma,tkColon]) then
-        ParseExc(SParserExpectedCommaColon);
+        ParseExc(nParserExpectedCommaColon,SParserExpectedCommaColon);
     Until (curToken=tkColon);
     ExpectToken(tkBraceOpen);
     NextToken;
@@ -3826,7 +3942,7 @@ begin
       tkConst:
         begin
         if Not AllowMethods then
-          ParseExc(SErrRecordConstantsNotAllowed);
+          ParseExc(nErrRecordConstantsNotAllowed,SErrRecordConstantsNotAllowed);
         ExpectToken(tkIdentifier);
         Cons:=ParseConstDecl(ARec);
         Cons.Visibility:=v;
@@ -3835,15 +3951,15 @@ begin
       tkClass:
         begin
         if Not AllowMethods then
-          ParseExc(SErrRecordMethodsNotAllowed);
+          ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed);
         if isClass then
-          ParseExc(SParserTypeSyntaxError);
+          ParseExc(nParserTypeSyntaxError,SParserTypeSyntaxError);
         isClass:=True;
         end;
       tkProperty:
         begin
         if Not AllowMethods then
-          ParseExc(SErrRecordPropertiesNotAllowed);
+          ParseExc(nErrRecordPropertiesNotAllowed,SErrRecordPropertiesNotAllowed);
         ExpectToken(tkIdentifier);
         Prop:=ParseProperty(ARec,CurtokenString,v);
         Prop.isClass:=isClass;
@@ -3854,7 +3970,7 @@ begin
       tkFunction :
         begin
         if Not AllowMethods then
-          ParseExc(SErrRecordMethodsNotAllowed);
+          ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed);
         ProcType:=GetProcTypeFromtoken(CurToken,isClass);
         Proc:=ParseProcedureOrFunctionDecl(ARec,ProcType,v);
         if Proc.Parent is TPasOverloadedProc then
@@ -3868,9 +3984,9 @@ begin
           if CheckVisibility(CurtokenString,v) then
             begin
             If not (po_delphi in Scanner.Options) then
-              ParseExc(SErrRecordVisibilityNotAllowed);
+              ParseExc(nErrRecordVisibilityNotAllowed,SErrRecordVisibilityNotAllowed);
             if not (v in [visPrivate,visPublic,visStrictPrivate]) then
-              ParseExc(SParserInvalidRecordVisibility);
+              ParseExc(nParserInvalidRecordVisibility,SParserInvalidRecordVisibility);
             NextToken;
             Continue;
             end;
@@ -3894,7 +4010,7 @@ begin
         ParseRecordVariantParts(ARec,AEndToken);
         end;
     else
-      ParseExc(SParserTypeSyntaxError);
+      ParseExc(nParserTypeSyntaxError,SParserTypeSyntaxError);
     end;
     If CurToken<>tkClass then
       isClass:=False;
@@ -3963,11 +4079,11 @@ begin
         visPrivate   : AVisibility:=visStrictPrivate;
         visProtected : AVisibility:=visStrictProtected;
       else
-        ParseExc(Format(SParserStrangeVisibility,[S]));
+        ParseExc(nParserStrangeVisibility,SParserStrangeVisibility,[S]);
       end
     end
   else if B then
-    ParseExc(SParserExpectVisibility);
+    ParseExc(nParserExpectVisibility,SParserExpectVisibility);
 end;
 
 procedure TPasParser.ProcessMethod(AType: TPasClassType; IsClass : Boolean; AVisibility : TPasMemberVisibility);
@@ -4073,7 +4189,7 @@ begin
       tkIdentifier:
         begin
         if (AType.ObjKind=okInterface) then
-          ParseExc(SParserNoFieldsAllowed);
+          ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowed);
         if CurToken=tkVar then
           ExpectToken(tkIdentifier);
         SaveComments;
@@ -4084,7 +4200,7 @@ begin
         begin
         SaveComments;
         if (Curtoken in [tkConstructor,tkDestructor]) and (AType.ObjKind in [okInterface,okRecordHelper]) then
-          ParseExc(SParserNoConstructorAllowed);
+          ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
         ProcessMethod(AType,False,CurVisibility);
         end;
       tkclass:
@@ -4104,7 +4220,7 @@ begin
            AType.Members.Add(ParseProperty(AType,CurtokenString,CurVisibility));
            end
          else
-           ParseExc(SParserTypeSyntaxError)
+           ParseExc(nParserTypeSyntaxError,SParserTypeSyntaxError)
         end;
       tkProperty:
         begin
@@ -4155,7 +4271,7 @@ begin
   if (AType.ObjKind in [okClassHelper,okRecordHelper]) then
     begin
     if (CurToken<>tkFor) then
-      ParseExc(Format(SParserExpectTokenError,[TokenInfos[tkFor]]));
+      ParseExcTokenError(TokenInfos[tkFor]);
     AType.HelperForType:=ParseType(Nil);
     NextToken;
     end;
@@ -4168,7 +4284,7 @@ begin
       NextToken;
       AType.GUIDExpr:=DoParseExpression(AType);
       if (CurToken<>tkSquaredBraceClose) then
-        ParseExc(Format(SParserExpectTokenError,[TokenInfos[tkSquaredBraceClose]]));
+        ParseExcTokenError(TokenInfos[tkSquaredBraceClose]);
       NextToken;
       end;
     ParseClassMembers(AType);
@@ -4202,7 +4318,7 @@ begin
   if (CurToken = tkHelper) then
     begin
     if Not (AObjKind in [okClass,okRecordHelper]) then
-      ParseExc(Format(SParserHelperNotAllowed,[ObjKindNames[AObjKind]]));
+      ParseExc(nParserHelperNotAllowed,SParserHelperNotAllowed,[ObjKindNames[AObjKind]]);
     if (AObjKind = okClass)  then
       AObjKind:=okClassHelper;
     NextToken;

packages/fcl-passrc/src/pscanner.pp

@@ -23,6 +23,24 @@ interface
 
 uses SysUtils, Classes;
 
+// message numbers
+const
+  nErrInvalidCharacter = 1001;
+  nErrOpenString = 1002;
+  nErrIncludeFileNotFound = 1003;
+  nErrIfXXXNestingLimitReached = 1004;
+  nErrInvalidPPElse = 1005;
+  nErrInvalidPPEndif = 1006;
+  nLogOpeningFile = 1007;
+  nLogLineNumber = 1008;
+  nLogIFDefAccepted = 1009;
+  nLogIFDefRejected = 1010;
+  nLogIFNDefAccepted = 1011;
+  nLogIFNDefRejected = 1012;
+  nLogIFOPTIgnored = 1013;
+  nLogIFIgnored = 1014;
+
+// resourcestring patterns of messages
 resourcestring
   SErrInvalidCharacter = 'Invalid character ''%s''';
   SErrOpenString = 'string exceeds end of line';
@@ -40,6 +58,18 @@ resourcestring
   SLogIFIgnored = 'IF %s found, ignoring (rejected).';
 
 type
+  TMessageType = (
+    mtFatal,
+    mtError,
+    mtWarning,
+    mtNote,
+    mtHint,
+    mtInfo,
+    mtDebug
+    );
+  TMessageTypes = set of TMessageType;
+
+  TMessageArgs = array of string;
 
   TToken = (
     tkEOF,
@@ -305,6 +335,11 @@ type
 
   TPascalScanner = class
   private
+    FLastMsg: string;
+    FLastMsgArgs: TMessageArgs;
+    FLastMsgNumber: integer;
+    FLastMsgPattern: string;
+    FLastMsgType: TMessageType;
     FFileResolver: TBaseFileResolver;
     FCurSourceFile: TLineReader;
     FCurFilename: string;
@@ -332,10 +367,11 @@ type
     function GetCurColumn: Integer;
     procedure SetOptions(AValue: TPOptions);
   protected
-    Procedure DoLog(Const Msg : String; SkipSourceInfo : Boolean = False);overload;
-    Procedure DoLog(Const Fmt : String; Args : Array of const;SkipSourceInfo : Boolean = False);overload;
-    procedure Error(const Msg: string);overload;
-    procedure Error(const Msg: string; Args: array of Const);overload;
+    procedure SetCurMsg(MsgType: TMessageType; MsgNumber: integer; Const Fmt : String; Args : Array of const);
+    Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Msg : String; SkipSourceInfo : Boolean = False);overload;
+    Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Fmt : String; Args : Array of const;SkipSourceInfo : Boolean = False);overload;
+    procedure Error(MsgNumber: integer; const Msg: string);overload;
+    procedure Error(MsgNumber: integer; const Fmt: string; Args: array of Const);overload;
     procedure HandleDefine(Param: String); virtual;
     procedure HandleIncludeFile(Param: String); virtual;
     procedure HandleUnDefine(Param: String);virtual;
@@ -372,6 +408,12 @@ type
     Property Options : TPOptions Read FOptions Write SetOptions;
     Property LogEvents : TPScannerLogEvents Read FLogEvents Write FLogEvents;
     Property OnLog : TPScannerLogHandler Read FOnLog Write FOnLog;
+
+    property LastMsg: string read FLastMsg write FLastMsg;
+    property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
+    property LastMsgType: TMessageType read FLastMsgType write FLastMsgType;
+    property LastMsgPattern: string read FLastMsgPattern write FLastMsgPattern;
+    property LastMsgArgs: TMessageArgs read FLastMsgArgs write FLastMsgArgs;
   end;
 
 const
@@ -496,6 +538,8 @@ function FilenameIsWinAbsolute(const TheFilename: string): boolean;
 function FilenameIsUnixAbsolute(const TheFilename: string): boolean;
 function IsNamedToken(Const AToken : String; Out T : TToken) : Boolean;
 
+procedure CreateMsgArgs(var MsgArgs: TMessageArgs; Args: array of const);
+
 implementation
 
 Var
@@ -576,6 +620,39 @@ begin
     T:=SortedTokens[I];
 end;
 
+procedure CreateMsgArgs(var MsgArgs: TMessageArgs; Args: array of const);
+var
+  i: Integer;
+begin
+  SetLength(MsgArgs, High(Args)-Low(Args)+1);
+  for i:=Low(Args) to High(Args) do
+  begin
+    case Args[i].VType of
+      vtInteger:      MsgArgs[i] := IntToStr(Args[i].VInteger);
+      vtBoolean:      MsgArgs[i] := BoolToStr(Args[i].VBoolean);
+      vtChar:         MsgArgs[i] := Args[i].VChar;
+      {$ifndef FPUNONE}
+      vtExtended:     ; //  Args[i].VExtended^;
+      {$ENDIF}
+      vtString:       MsgArgs[i] := Args[i].VString^;
+      vtPointer:      ; //  Args[i].VPointer;
+      vtPChar:        MsgArgs[i] := Args[i].VPChar;
+      vtObject:       ; //  Args[i].VObject;
+      vtClass:        ; //  Args[i].VClass;
+      vtWideChar:     MsgArgs[i] := AnsiString(Args[i].VWideChar);
+      vtPWideChar:    MsgArgs[i] := Args[i].VPWideChar;
+      vtAnsiString:   MsgArgs[i] := AnsiString(Args[i].VAnsiString);
+      vtCurrency:     ; //  Args[i].VCurrency^);
+      vtVariant:      ; //  Args[i].VVariant^);
+      vtInterface:    ; //  Args[i].VInterface^);
+      vtWidestring:   MsgArgs[i] := AnsiString(WideString(Args[i].VWideString));
+      vtInt64:        MsgArgs[i] := IntToStr(Args[i].VInt64^);
+      vtQWord:        MsgArgs[i] := IntToStr(Args[i].VQWord^);
+      vtUnicodeString:MsgArgs[i] := AnsiString(UnicodeString(Args[i].VUnicodeString));
+    end;
+  end;
+end;
+
 type
   TIncludeStackItem = class
     SourceFile: TLineReader;
@@ -1020,7 +1097,7 @@ begin
   Clearfiles;
   FCurSourceFile := FileResolver.FindSourceFile(AFilename);
   if LogEvent(sleFile) then
-    DoLog(SLogOpeningFile,[AFileName],True);
+    DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[AFileName],True);
   FCurFilename := AFilename;
   FileResolver.BaseDirectory := IncludeTrailingPathDelimiter(ExtractFilePath(AFilename));
 end;
@@ -1069,14 +1146,17 @@ begin
 //  Writeln(Result, '(',CurTokenString,')');
 end;
 
-procedure TPascalScanner.Error(const Msg: string);
+procedure TPascalScanner.Error(MsgNumber: integer; const Msg: string);
 begin
+  SetCurMsg(mtError,MsgNumber,Msg,[]);
   raise EScannerError.Create(Msg);
 end;
 
-procedure TPascalScanner.Error(const Msg: string; Args: array of Const);
+procedure TPascalScanner.Error(MsgNumber: integer; const Fmt: string;
+  Args: array of const);
 begin
-  raise EScannerError.CreateFmt(Msg, Args);
+  SetCurMsg(mtError,MsgNumber,Fmt,Args);
+  raise EScannerError.CreateFmt(Fmt, Args);
 end;
 
 function TPascalScanner.DoFetchTextToken:TToken;
@@ -1122,7 +1202,7 @@ begin
                 break;
 
             if TokenStr[0] = #0 then
-              Error(SErrOpenString);
+              Error(nErrOpenString,SErrOpenString);
 
             Inc(TokenStr);
           end;
@@ -1141,7 +1221,7 @@ begin
 
 end;
 
-Procedure TPascalScanner.PushStackItem;
+procedure TPascalScanner.PushStackItem;
 
 Var
   SI: TIncludeStackItem;
@@ -1160,7 +1240,7 @@ begin
   FCurRow := 0;
 end;
 
-Procedure TPascalScanner.HandleIncludeFile(Param : String);
+procedure TPascalScanner.HandleIncludeFile(Param: String);
 
 begin
   PushStackItem;
@@ -1171,12 +1251,12 @@ begin
     end;
   FCurSourceFile := FileResolver.FindIncludeFile(Param);
   if not Assigned(FCurSourceFile) then
-    Error(SErrIncludeFileNotFound, [Param]);
+    Error(nErrIncludeFileNotFound, SErrIncludeFileNotFound, [Param]);
   FCurFilename := Param;
   if FCurSourceFile is TFileLineReader then
     FCurFilename := TFileLineReader(FCurSourceFile).Filename; // nicer error messages
   If LogEvent(sleFile) then
-    DoLog(SLogOpeningFile,[FCurFileName],True);
+    DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FCurFileName],True);
 end;
 
 function TPascalScanner.HandleMacro(AIndex : integer) : TToken;
@@ -1196,7 +1276,7 @@ begin
 //  Writeln(Result,Curtoken);
 end;
 
-Procedure TPascalScanner.HandleDefine(Param : String);
+procedure TPascalScanner.HandleDefine(Param: String);
 
 Var
   Index : Integer;
@@ -1220,7 +1300,7 @@ begin
     end;
 end;
 
-Procedure TPascalScanner.HandleUnDefine(Param : String);
+procedure TPascalScanner.HandleUnDefine(Param: String);
 
 Var
   Index : integer;
@@ -1257,7 +1337,7 @@ function TPascalScanner.DoFetchToken: TToken;
       Result := true;
       Inc(FCurRow);
       if LogEvent(sleLineNumber) and ((FCurRow Mod 100) = 0) then
-        DoLog(SLogLineNumber,[FCurRow],True);
+        DoLog(mtInfo,nLogLineNumber,SLogLineNumber,[FCurRow],True);
     end;
   end;
 
@@ -1660,7 +1740,7 @@ begin
             if (Directive = 'IFDEF') then
               begin
               if PPSkipStackIndex = High(PPSkipModeStack) then
-                Error(SErrIfXXXNestingLimitReached);
+                Error(nErrIfXXXNestingLimitReached,SErrIfXXXNestingLimitReached);
               PPSkipModeStack[PPSkipStackIndex] := PPSkipMode;
               PPIsSkippingStack[PPSkipStackIndex] := PPIsSkipping;
               Inc(PPSkipStackIndex);
@@ -1682,14 +1762,14 @@ begin
                   PPSkipMode := ppSkipElseBranch;
                 If LogEvent(sleConditionals) then
                   if PPSkipMode=ppSkipElseBranch then
-                    DoLog(SLogIFDefAccepted,[Param])
+                    DoLog(mtInfo,nLogIFDefAccepted,sLogIFDefAccepted,[Param])
                   else
-                    DoLog(SLogIFDefRejected,[Param])
+                    DoLog(mtInfo,nLogIFDefRejected,sLogIFDefRejected,[Param])
               end;
             end else if Directive = 'IFNDEF' then
             begin
               if PPSkipStackIndex = High(PPSkipModeStack) then
-                Error(SErrIfXXXNestingLimitReached);
+                Error(nErrIfXXXNestingLimitReached,sErrIfXXXNestingLimitReached);
               PPSkipModeStack[PPSkipStackIndex] := PPSkipMode;
               PPIsSkippingStack[PPSkipStackIndex] := PPIsSkipping;
               Inc(PPSkipStackIndex);
@@ -1709,14 +1789,14 @@ begin
                   PPSkipMode := ppSkipElseBranch;
                 If LogEvent(sleConditionals) then
                   if PPSkipMode=ppSkipElseBranch then
-                    DoLog(SLogIFNDefAccepted,[Param])
+                    DoLog(mtInfo,nLogIFNDefAccepted,sLogIFNDefAccepted,[Param])
                   else
-                    DoLog(SLogIFNDefRejected,[Param])
+                    DoLog(mtInfo,nLogIFNDefRejected,sLogIFNDefRejected,[Param])
               end;
             end else if Directive = 'IFOPT' then
             begin
               if PPSkipStackIndex = High(PPSkipModeStack) then
-                Error(SErrIfXXXNestingLimitReached);
+                Error(nErrIfXXXNestingLimitReached,sErrIfXXXNestingLimitReached);
               PPSkipModeStack[PPSkipStackIndex] := PPSkipMode;
               PPIsSkippingStack[PPSkipStackIndex] := PPIsSkipping;
               Inc(PPSkipStackIndex);
@@ -1732,11 +1812,11 @@ begin
                 PPIsSkipping := true;
               end;
               If LogEvent(sleConditionals) then
-                DoLog(SLogIFOPTIgnored,[Uppercase(Param)])
+                DoLog(mtInfo,nLogIFOPTIgnored,sLogIFOPTIgnored,[Uppercase(Param)])
             end else if Directive = 'IF' then
             begin
               if PPSkipStackIndex = High(PPSkipModeStack) then
-                Error(SErrIfXXXNestingLimitReached);
+                Error(nErrIfXXXNestingLimitReached,sErrIfXXXNestingLimitReached);
               PPSkipModeStack[PPSkipStackIndex] := PPSkipMode;
               PPIsSkippingStack[PPSkipStackIndex] := PPIsSkipping;
               Inc(PPSkipStackIndex);
@@ -1751,12 +1831,12 @@ begin
                 PPSkipMode := ppSkipIfBranch;
                 PPIsSkipping := true;
               If LogEvent(sleConditionals) then
-                 DoLog(SLogIFIgnored,[Uppercase(Param)])
+                 DoLog(mtInfo,nLogIFIgnored,sLogIFIgnored,[Uppercase(Param)])
               end;
             end else if Directive = 'ELSE' then
             begin
               if PPSkipStackIndex = 0 then
-                Error(SErrInvalidPPElse);
+                Error(nErrInvalidPPElse,sErrInvalidPPElse);
               if PPSkipMode = ppSkipIfBranch then
                 PPIsSkipping := false
               else if PPSkipMode = ppSkipElseBranch then
@@ -1764,7 +1844,7 @@ begin
             end else if ((Directive = 'ENDIF') or (Directive='IFEND')) then
             begin
               if PPSkipStackIndex = 0 then
-                Error(SErrInvalidPPEndif);
+                Error(nErrInvalidPPEndif,sErrInvalidPPEndif);
               Dec(PPSkipStackIndex);
               PPSkipMode := PPSkipModeStack[PPSkipStackIndex];
               PPIsSkipping := PPIsSkippingStack[PPSkipStackIndex];
@@ -1800,7 +1880,7 @@ begin
     if PPIsSkipping then
       Inc(TokenStr)
     else
-      Error(SErrInvalidCharacter, [TokenStr[0]]);
+      Error(nErrInvalidCharacter, SErrInvalidCharacter, [TokenStr[0]]);
   end;
 
   FCurToken := Result;
@@ -1819,18 +1899,21 @@ begin
     Result:=0;
 end;
 
-procedure TPascalScanner.DoLog(const Msg: String;SkipSourceInfo : Boolean = False);
+procedure TPascalScanner.DoLog(MsgType: TMessageType; MsgNumber: integer;
+  const Msg: String; SkipSourceInfo: Boolean);
 begin
-  If Assigned(FOnLog) then
-    if SkipSourceInfo then
-      FOnLog(Self,Msg)
-    else
-      FOnLog(Self,Format('%s(%d) : %s',[FCurFileName,FCurRow,Msg]));
+  DoLog(MsgType,MsgNumber,Msg,[],SkipSourceInfo);
 end;
 
-procedure TPascalScanner.DoLog(const Fmt: String; Args: array of const;SkipSourceInfo : Boolean = False);
+procedure TPascalScanner.DoLog(MsgType: TMessageType; MsgNumber: integer;
+  const Fmt: String; Args: array of const; SkipSourceInfo: Boolean);
 begin
-  DoLog(Format(Fmt,Args),SkipSourceInfo);
+  SetCurMsg(MsgType,MsgNumber,Fmt,Args);
+  If Assigned(FOnLog) then
+    if SkipSourceInfo then
+      FOnLog(Self,FLastMsg)
+    else
+      FOnLog(Self,Format('%s(%d) : %s',[FCurFileName,FCurRow,FLastMsg]));
 end;
 
 procedure TPascalScanner.SetOptions(AValue: TPOptions);
@@ -1839,14 +1922,24 @@ begin
   FOptions:=AValue;
 end;
 
-Procedure TPascalScanner.AddDefine(S : String);
+procedure TPascalScanner.SetCurMsg(MsgType: TMessageType; MsgNumber: integer;
+  const Fmt: String; Args: array of const);
+begin
+  FLastMsgType := MsgType;
+  FLastMsgNumber := MsgNumber;
+  FLastMsgPattern := Fmt;
+  FLastMsg := Format(Fmt,Args);
+  CreateMsgArgs(FLastMsgArgs,Args);
+end;
+
+procedure TPascalScanner.AddDefine(S: String);
 
 begin
   If FDefines.IndexOf(S)=-1 then
     FDefines.Add(S);
 end;
 
-Procedure TPascalScanner.RemoveDefine(S : String);
+procedure TPascalScanner.RemoveDefine(S: String);
 
 Var
   I : Integer;

packages/fcl-passrc/tests/tcstatements.pas

@@ -75,6 +75,7 @@ Type
     Procedure TestCase2Cases;
     Procedure TestCaseBlock;
     Procedure TestCaseElseBlockEmpty;
+    procedure TestCaseOtherwiseBlockEmpty;
     Procedure TestCaseElseBlockAssignment;
     Procedure TestCaseElseBlock2Assignments;
     Procedure TestCaseIfCaseElse;
@@ -974,6 +975,23 @@ begin
   AssertEquals('Zero statements ',0,TPasImplCaseElse(C.ElseBranch).Elements.Count);
 end;
 
+procedure TTestStatementParser.TestCaseOtherwiseBlockEmpty;
+
+Var
+  C : TPasImplCaseOf;
+  S : TPasImplCaseStatement;
+  B : TPasImplbeginBlock;
+
+begin
+  DeclareVar('integer');
+  TestStatement(['case a of','1 : begin end;','otherwise',' end;']);
+  C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
+  AssertNotNull('Have case expression',C.CaseExpr);
+  AssertNotNull('Have else branch',C.ElseBranch);
+  AssertEquals('Correct else branch class',TPasImplCaseElse,C.ElseBranch.ClassType);
+  AssertEquals('Zero statements ',0,TPasImplCaseElse(C.ElseBranch).Elements.Count);
+end;
+
 procedure TTestStatementParser.TestCaseElseBlockAssignment;
 Var
   C : TPasImplCaseOf;

utils/fpdoc/css.inc

@@ -1,6 +1,6 @@
 
 Const
-  DefaultCSS : Array[0..2254] of byte = (
+  DefaultCSS : Array[0..2649] of byte = (
       47, 42, 10, 32, 32, 36, 73,100, 58, 32,102,112,100,111, 99, 46, 99,
      115,115, 44,118, 32, 49, 46, 49, 32, 50, 48, 48, 51, 47, 48, 51, 47,
       49, 55, 32, 50, 51, 58, 48, 51, 58, 50, 48, 32,109,105, 99,104, 97,
@@ -100,37 +100,60 @@ Const
      111,108,111,114, 58, 32, 35,102,102,102,102, 99, 48, 59, 10,125, 10,
       10,116, 97, 98,108,101, 46, 98, 97,114, 32,123, 10, 32, 32, 98, 97,
       99,107,103,114,111,117,110,100, 45, 99,111,108,111,114, 58, 32, 35,
-      97, 48, 99, 48,102,102, 59, 10,125, 10, 10,115,112, 97,110, 46, 98,
-      97,114,116,105,116,108,101, 32,123, 10, 32, 32,102,111,110,116, 45,
-     119,101,105,103,104,116, 58, 32, 98,111,108,100, 59, 10, 32, 32,102,
-     111,110,116, 45,115,116,121,108,101, 58, 32,105,116, 97,108,105, 99,
-      59, 10, 32, 32, 99,111,108,111,114, 58, 32,100, 97,114,107, 98,108,
-     117,101, 10,125, 10, 10,115,112, 97,110, 46,102,111,111,116,101,114,
-      32,123, 10, 32, 32,102,111,110,116, 45,115,116,121,108,101, 58, 32,
-     105,116, 97,108,105, 99, 59, 10, 32, 32, 99,111,108,111,114, 58, 32,
-     100, 97,114,107, 98,108,117,101, 10,125, 10, 10, 47, 42, 32,100,101,
-     102,105,110,105,116,105,111,110, 32,108,105,115,116, 32, 42, 47, 10,
-     100,108, 32,123, 10, 32, 98,111,114,100,101,114, 58, 32, 51,112,120,
-      32,100,111,117, 98,108,101, 32, 35, 99, 99, 99, 59, 10, 32,112, 97,
-     100,100,105,110,103, 58, 32, 48, 46, 53,101,109, 59, 10,125, 10, 10,
+      97, 48, 99, 48,102,102, 59, 10,125, 10, 10,116,100, 32,112, 32,123,
+      10, 32,109, 97,114,103,105,110, 58, 32, 48, 59, 10,125, 10, 10,115,
+     112, 97,110, 46, 98, 97,114,116,105,116,108,101, 32,123, 10, 32, 32,
+     102,111,110,116, 45,119,101,105,103,104,116, 58, 32, 98,111,108,100,
+      59, 10, 32, 32,102,111,110,116, 45,115,116,121,108,101, 58, 32,105,
+     116, 97,108,105, 99, 59, 10, 32, 32, 99,111,108,111,114, 58, 32,100,
+      97,114,107, 98,108,117,101, 10,125, 10, 10,115,112, 97,110, 46,102,
+     111,111,116,101,114, 32,123, 10, 32, 32,102,111,110,116, 45,115,116,
+     121,108,101, 58, 32,105,116, 97,108,105, 99, 59, 10, 32, 32, 99,111,
+     108,111,114, 58, 32,100, 97,114,107, 98,108,117,101, 10,125, 10, 10,
       47, 42, 32,100,101,102,105,110,105,116,105,111,110, 32,108,105,115,
-     116, 58, 32,116,101,114,109, 32, 42, 47, 10,100,116, 32,123, 10, 32,
-     102,108,111, 97,116, 58, 32,108,101,102,116, 59, 10, 32, 99,108,101,
-      97,114, 58, 32,108,101,102,116, 59, 10, 32,119,105,100,116,104, 58,
-      32, 97,117,116,111, 59, 32, 47, 42, 32,110,111,114,109, 97,108,108,
-     121, 32, 98,114,111,119,115,101,114,115, 32,100,101,102, 97,117,108,
-     116, 32,119,105,100,116,104, 32,111,102, 32,108, 97,114,103,101,115,
-     116, 32,105,116,101,109, 32, 42, 47, 10, 32,112, 97,100,100,105,110,
-     103, 45,114,105,103,104,116, 58, 32, 50, 48,112,120, 59, 10, 32,102,
-     111,110,116, 45,119,101,105,103,104,116, 58, 32, 98,111,108,100, 59,
-      10, 32, 99,111,108,111,114, 58, 32,100, 97,114,107,103,114,101,101,
-     110, 59, 10,125, 10, 10, 47, 42, 32,100,101,102,105,110,105,116,105,
-     111,110, 32,108,105,115,116, 58, 32,100,101,115, 99,114,105,112,116,
-     105,111,110, 32, 42, 47, 10,100,100, 32,123, 10, 32,109, 97,114,103,
-     105,110, 58, 32, 48, 32, 48, 32, 48, 32, 49, 49, 48,112,120, 59, 10,
-      32,112, 97,100,100,105,110,103, 58, 32, 48, 32, 48, 32, 48, 46, 53,
-     101,109, 32, 48, 59, 10,125, 10, 10, 47, 42, 32,102,111,114, 32, 98,
-     114,111,119,115,101,114,115, 32,105,110, 32,115,116, 97,110,100, 97,
-     114,100,115, 32, 99,111,109,112,108,105, 97,110, 99,101, 32,109,111,
-     100,101, 32, 42, 47, 10,116,100, 32,112, 32,123, 10, 32, 32,109, 97,
-     114,103,105,110, 58, 32, 48, 59, 10,125, 10);
+     116, 32, 42, 47, 10,100,108, 32,123, 10, 32, 98,111,114,100,101,114,
+      58, 32, 51,112,120, 32,100,111,117, 98,108,101, 32, 35, 99, 99, 99,
+      59, 10, 32,112, 97,100,100,105,110,103, 58, 32, 48, 46, 53,101,109,
+      59, 10,125, 10, 10, 47, 42, 32,100,101,102,105,110,105,116,105,111,
+     110, 32,108,105,115,116, 58, 32,116,101,114,109, 32, 42, 47, 10,100,
+     116, 32,123, 10, 32,102,108,111, 97,116, 58, 32,108,101,102,116, 59,
+      10, 32, 99,108,101, 97,114, 58, 32,108,101,102,116, 59, 10, 32,119,
+     105,100,116,104, 58, 32, 97,117,116,111, 59, 32, 47, 42, 32,110,111,
+     114,109, 97,108,108,121, 32, 98,114,111,119,115,101,114,115, 32,100,
+     101,102, 97,117,108,116, 32,119,105,100,116,104, 32,111,102, 32,108,
+      97,114,103,101,115,116, 32,105,116,101,109, 32, 42, 47, 10, 32,112,
+      97,100,100,105,110,103, 45,114,105,103,104,116, 58, 32, 50, 48,112,
+     120, 59, 10, 32,102,111,110,116, 45,119,101,105,103,104,116, 58, 32,
+      98,111,108,100, 59, 10, 32, 99,111,108,111,114, 58, 32,100, 97,114,
+     107,103,114,101,101,110, 59, 10,125, 10, 10, 47, 42, 32,100,101,102,
+     105,110,105,116,105,111,110, 32,108,105,115,116, 58, 32,100,101,115,
+      99,114,105,112,116,105,111,110, 32, 42, 47, 10,100,100, 32,123, 10,
+      32,109, 97,114,103,105,110, 58, 32, 48, 32, 48, 32, 48, 32, 49, 49,
+      48,112,120, 59, 10, 32,112, 97,100,100,105,110,103, 58, 32, 48, 32,
+      48, 32, 48, 46, 53,101,109, 32, 48, 59, 10,125, 10, 10, 47, 42, 32,
+     102,111,114, 32, 98,114,111,119,115,101,114,115, 32,105,110, 32,115,
+     116, 97,110,100, 97,114,100,115, 32, 99,111,109,112,108,105, 97,110,
+      99,101, 32,109,111,100,101, 32, 42, 47, 10,116,100, 32,112, 32,123,
+      10, 32, 32,109, 97,114,103,105,110, 58, 32, 48, 59, 10,125, 10, 10,
+     115,112, 97,110, 46,116,111,103,103,108,101,116,114,101,101, 99,108,
+     111,115,101, 32,123, 10, 32, 32, 32, 32, 98, 97, 99,107,103,114,111,
+     117,110,100, 58, 32,117,114,108, 40,109,105,110,117,115, 46,112,110,
+     103, 41, 32, 99,101,110,116,101,114, 32,108,101,102,116, 32,110,111,
+      45,114,101,112,101, 97,116, 59, 10, 32, 32, 32, 32,112, 97,100,100,
+     105,110,103, 45,108,101,102,116, 58, 32, 50, 48,112,120, 59, 10,125,
+      10,115,112, 97,110, 46,116,111,103,103,108,101,116,114,101,101,111,
+     112,101,110, 32,123, 10, 32, 32, 32, 32, 98, 97, 99,107,103,114,111,
+     117,110,100, 58, 32,117,114,108, 40,112,108,117,115, 46,112,110,103,
+      41, 32, 99,101,110,116,101,114, 32,108,101,102,116, 32,110,111, 45,
+     114,101,112,101, 97,116, 59, 10, 32, 32, 32, 32,112, 97,100,100,105,
+     110,103, 45,108,101,102,116, 58, 32, 50, 48,112,120, 59, 10,125, 10,
+      10,117,108, 46, 99,108, 97,115,115,116,114,101,101,108,105,115,116,
+      32,108,105, 32,123, 32,112, 97,100,100,105,110,103, 45,108,101,102,
+     116, 58, 32, 48,112,120, 59, 32,125, 10, 10,117,108, 46, 99,108, 97,
+     115,115,116,114,101,101,108,105,115,116, 32,123, 32,108,105,115,116,
+      45,115,116,121,108,101, 45,116,121,112,101, 58,110,111,110,101, 59,
+      32,125, 10, 10,108,105, 46, 99,108, 97,115,115,116,114,101,101, 32,
+     117,108, 32,123, 32,100,105,115,112,108, 97,121, 58, 32, 98,108,111,
+      99,107, 59, 32,125, 10, 32, 10,108,105, 46, 99,108, 97,115,115,116,
+     114,101,101, 99,108,111,115,101,100, 32,117,108, 32,123, 32,100,105,
+     115,112,108, 97,121, 58, 32,110,111,110,101, 59, 32,125, 10);

utils/fpdoc/dglobals.pp

@@ -144,6 +144,8 @@ resourcestring
   SCopyright2      = '(c) 2005 - 2012 various FPC contributors';
 
   SCmdLineHelp     = 'Usage: %s [options]';
+  SUsageOption008  = '--base-descr-dir=DIR prefix all description files with this directory';
+  SUsageOption009  = '--base-input-dir=DIR prefix all input files with this directory';
   SUsageOption010  = '--content         Create content file for package cross-references';
   SUsageOption020  = '--cputarget=value Set the target CPU for the scanner.';
   SUsageOption030  = '--descr=file      use file as description file, e.g.: ';
@@ -711,9 +713,9 @@ var
     end;
   end;
 
-  function ResolvePackageModule(AName:String;var pkg:TPasPackage;var module:TPasModule;createnew:boolean):String;
+  function ResolvePackageModule(AName:String;out pkg:TPasPackage;out module:TPasModule;createnew:boolean):String;
     var
-      DotPos, DotPos2, i,j: Integer;
+      DotPos, DotPos2, i: Integer;
       s: String;
       HPackage: TPasPackage;
 
@@ -809,7 +811,6 @@ var
 
     function CreateClass(const AName: String;InheritanceStr:String): TPasClassType;
     var
-      DotPos, DotPos2, i,j: Integer;
       s: String;
       HPackage: TPasPackage;
       Module: TPasModule;
@@ -1446,9 +1447,7 @@ Var
   end;
 
 var
-  i: Integer;
   Node, Subnode, Subsubnode: TDOMNode;
-  Element: TDOMElement;
   Doc: TXMLDocument;
   PackageDocNode, TopicNode,ModuleDocNode: TDocNode;
 
@@ -1601,9 +1600,6 @@ end;
 
 function TFPDocEngine.FindLinkedNode(ANode : TDocNode) : TDocNode;
 
-Var
-  S: String;
-
 begin
   If (ANode.Link='') then
     Result:=Nil

utils/fpdoc/dw_html.pp

@@ -2471,7 +2471,7 @@ begin
     try
       B.BuildTree(AList);
       // Classes
-      WriteXMLFile(B.ClassTree,'tree.xml');
+      // WriteXMLFile(B.ClassTree,'tree.xml');
       // Dummy TObject
       E:=B.ClassTree.DocumentElement;
       PushClassList;

utils/fpdoc/examples/basedir/readme.txt

@@ -0,0 +1,11 @@
+This directory demonstrates the use of a fpdoc project file.
+It uses the files in the examples/simple directory.
+
+The project file contains the names of the files without paths.
+That means that fpdoc must be executed from this directory, 
+supplying the paths to the input and description files
+
+fpdoc --project=sample-project.xml --base-input-dir=../simple --base-descr-dir=../simple
+
+The docs will be written to a subdirectory doc. 
+This directory can be deleted if it is no longer necessary.

utils/fpdoc/examples/basedir/sample-project.xml

@@ -0,0 +1,29 @@
+<docproject>
+  <packages>
+    <!-- Multiple packages can be entered. 
+         If only one is specified, it is selected. 
+         "name" is a mandatory attribute
+         a "units" tag is required, and a "descriptions" tag as well
+    -->
+    <package name="fpdocsample" output="doc" contentfile="fpdocsample.cnt">
+      <!-- All input files, one "unit" tag per unit -->
+      <units>
+        <!-- "file" is a mandatory attribute, "options" is not mandatory -->
+        <unit file="testunit.pp" options="-S2"/>
+      </units>
+      <descriptions>
+        <!-- Description files here. One "description" tag per file.
+            "file" is the only mandatory attribute -->
+        <description file="testunit.xml"/>
+      </descriptions>
+    </package>
+  </packages>
+  <options>
+    <!-- All command-line options can be specified here with the same name
+         and value as on the actual command-line. Boolean options must have
+         a value of 'true', '1' or 'yes' -->
+    <option name="format" value="html"/>
+    <option name="hide-protected" value="true"/>
+    <option name="footer-date" value="yyyy-mm-dd"/>
+  </options>
+</docproject>

utils/fpdoc/examples/project/readme.txt

@@ -0,0 +1,10 @@
+This directory demonstrates the use of a fpdoc project file.
+It uses the files in the examples/simple directory.
+
+The project file contains the names of the files with relative paths.
+That means that fpdoc must be executed from this directory:
+
+fpdoc --project=sample-project.xml
+
+The docs will be written to a subdirectory doc. 
+This directory can be deleted if it is no longer necessary.

utils/fpdoc/examples/project/sample-project.xml

@@ -0,0 +1,29 @@
+<docproject>
+  <packages>
+    <!-- Multiple packages can be entered. 
+         If only one is specified, it is selected. 
+         "name" is a mandatory attribute
+         a "units" tag is required, and a "descriptions" tag as well
+    -->
+    <package name="fpdocsample" output="doc" contentfile="fpdocsample.cnt">
+      <!-- All input files, one "unit" tag per unit -->
+      <units>
+        <!-- "file" is a mandatory attribute, "options" is not mandatory -->
+        <unit file="../simple/testunit.pp" options="-S2"/>
+      </units>
+      <descriptions>
+        <!-- Description files here. One "description" tag per file.
+            "file" is the only mandatory attribute -->
+        <description file="../simple/testunit.xml"/>
+      </descriptions>
+    </package>
+  </packages>
+  <options>
+    <!-- All command-line options can be specified here with the same name
+         and value as on the actual command-line. Boolean options must have
+         a value of 'true', '1' or 'yes' -->
+    <option name="format" value="html"/>
+    <option name="hide-protected" value="true"/>
+    <option name="footer-date" value="yyyy-mm-dd"/>
+  </options>
+</docproject>

utils/fpdoc/examples/simple/html.bat

@@ -0,0 +1,2 @@
+rem Command line to create html docs.
+fpdoc --package=fpdocsample --output=doc --format=html --input="-S2 testunit.pp" --descr=testunit.xml

utils/fpdoc/examples/simple/html.sh

@@ -0,0 +1,2 @@
+#!/bin/sh
+fpdoc --package=fpdocsample --output=doc --format=html --input='-S2 testunit.pp' --descr=testunit.xml

utils/fpdoc/examples/simple/readme.txt

@@ -0,0 +1,9 @@
+This directory contains the files for the projects.
+
+You can create HTML documentation using just the command-line by executing the
+following command in this directory:
+
+(on 1 line)
+fpdoc --package=fpdocsample --output=doc --format=html --input='-S2 testunit.pp' --descr=testunit.xml
+
+Sample command-lines can be found in html.sh and html.bat

utils/fpdoc/fpclasschart.pp

@@ -25,7 +25,6 @@ resourcestring
   STitle = 'fpClassTree - Create class tree from pascal sources';
   SVersion = 'Version %s [%s]';
   SCopyright = '(c) 2008 - Michael Van Canneyt, [email protected]';
-  SCmdLineHelp = 'See documentation for usage.';
   SCmdLineInvalidOption = 'Ignoring unknown option "%s"';
   SDone = 'Done.';
   SSkipMerge = 'Cannot merge %s into %s tree.';
@@ -213,7 +212,6 @@ end;
 procedure TClassChartFormatter.EmitClass(E : TDomElement; HasSiblings: Boolean);
 
 Var
-  DidSub : Boolean;
   N : TDomNode;
   I : Integer;
   L : TFPList;
@@ -235,7 +233,6 @@ begin
       end;
     DoEmitClass(E);
     N:=E.FirstChild;
-    DidSub:=False;
     L:=TFPList.Create;
     try
       While (N<>Nil) do
@@ -432,8 +429,6 @@ function TClassTreeEngine.CreateElement(AClass: TPTreeElement; const AName: Stri
   AParent: TPasElement; AVisibility : TPasMemberVisibility;
   const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
 
-Var
-  DN : TDocNode;
 
 begin
   Result := AClass.Create(AName, AParent);
@@ -478,6 +473,7 @@ Var
 
 
 begin
+  Result:=0;
   N:=Source.FirstChild;
   While (N<>Nil) do
     begin
@@ -503,7 +499,6 @@ Function MergeTrees (Dest,Source : TXMLDocument) : Integer;
 
 Var
   S,D : TDomElement;
-  Count : Integer;
 
 begin
   Result:=0;
@@ -524,28 +519,30 @@ Var
   Engine: TClassTreeEngine;
 
 begin
+  Result:='';
+  ACount:=0;
   XML:=TXMLDocument.Create;
   Try
     //XML.
-    XML.AppendChild(XML.CreateElement(ObjKindNames[AObjectKind]));
+    XML.AppendChild(XML.CreateElement('TObject'));
     For I:=0 to MergeFiles.Count-1 do
       begin
       XMl2:=TXMLDocument.Create;
       ReadXMLFile(XML2,MergeFiles[i]);
       try
-        ACount:=MergeTrees(XML,XML2);
+        ACount:=ACount+MergeTrees(XML,XML2);
         WriteLn(StdErr,Format(SMergedFile,[ACount,MergeFiles[i]]));
       Finally
         FreeAndNil(XML2);
       end;
       end;
-    ACount:=0;
     For I:=0 to InputFiles.Count-1 do
       begin
       Engine := TClassTreeEngine.Create(XML,AObjectKind);
       Try
         ParseSource(Engine,InputFiles[I],OSTarget,CPUTarget);
-        ACount:=ACount+Engine.Ftree.BuildTree(Engine.FObjects);
+        Engine.Ftree.BuildTree(Engine.FObjects);
+        ACount:=ACount+MergeTrees(XML,Engine.FTree.ClassTree);
       Finally
         FreeAndNil(Engine);
       end;
@@ -586,7 +583,6 @@ var
   InputFiles, 
   MergeFiles : TStringList;
   DocLang : String;
-  PackageName, 
   OutputName: String;
 
 procedure InitOptions;

utils/fpdoc/fpdoc.css

@@ -127,6 +127,10 @@ table.bar {
   background-color: #a0c0ff;
 }
 
+td p {
+ margin: 0;
+}
+
 span.bartitle {
   font-weight: bold;
   font-style: italic;
@@ -164,3 +168,20 @@ dd {
 td p {
   margin: 0;
 }
+
+span.toggletreeclose {
+    background: url(minus.png) center left no-repeat;
+    padding-left: 20px;
+}
+span.toggletreeopen {
+    background: url(plus.png) center left no-repeat;
+    padding-left: 20px;
+}
+
+ul.classtreelist li { padding-left: 0px; }
+
+ul.classtreelist { list-style-type:none; }
+
+li.classtree ul { display: block; }
+ 
+li.classtreeclosed ul { display: none; }

utils/fpdoc/fpdoc.pp

@@ -73,6 +73,8 @@ Var
 
 begin
   Writeln(Format(SCmdLineHelp,[ExtractFileName(Paramstr(0))]));
+  Writeln(SUsageOption008);
+  Writeln(SUsageOption009);
   Writeln(SUsageOption010);
   Writeln(SUsageOption020);
   Writeln(SUsageOption030);
@@ -321,6 +323,8 @@ begin
       AddToFileList(SelectedPackage.Descriptions, Arg)
     else if (Cmd = '--descr-dir') then
       AddDirToFileList(SelectedPackage.Descriptions, Arg, '*.xml')
+    else if (Cmd = '--base-descr-dir') then
+      FCreator.BaseDescrDir:=Arg
     else if (Cmd = '-f') or (Cmd = '--format') then
       begin
       Arg:=UpperCase(Arg);
@@ -333,6 +337,8 @@ begin
       FCreator.Options.Language := Arg
     else if (Cmd = '-i') or (Cmd = '--input') then
       AddToFileList(SelectedPackage.Inputs, Arg)
+    else if (Cmd = '--base-input-dir') then
+      FCreator.BaseInputDir:=Arg
     else if (Cmd = '--input-dir') then
       begin
       AddDirToFileList(SelectedPackage.Inputs, Arg,'*.pp');

utils/fpdoc/fpdocclasstree.pp

@@ -30,8 +30,7 @@ implementation
 
 constructor TClassTreeBuilder.Create(APackage : TPasPackage;
   AObjectKind: TPasObjKind);
-Var
-  N : TDomNode;
+
 begin
   FCLassTree:=TXMLDocument.Create;
   FPackage:=APAckage;
@@ -82,7 +81,7 @@ begin
     S:=N.NodeName;
     if NoPath then
       Begin
-      Result:= (CompareText(S,AElement.Name)=0);
+      Result:=(CompareText(S,AElement.Name)=0);
       end
     else
       begin
@@ -132,10 +131,11 @@ Var
   N : TDomNode;
 
 begin
-  //Writeln('Enter TClassTreeBuilder.AddToClassTree');
+
+//  Writeln('Enter TClassTreeBuilder.AddToClassTree');
   //if Assigned(AElement) then
     //Writeln('Addtoclasstree : ',aElement.Name);
-  Result:=Nil; N:=Nil;PE:=NIL;
+  Result:=Nil; M:=Nil; N:=Nil;PE:=NIL;PC:=Nil;
   If (AElement=Nil) then
     begin
     Result:=FTreeStart;
@@ -145,9 +145,7 @@ begin
     begin
     N:=LookForElement(FTreeStart,AElement,True);
     If (N=Nil) then
-      begin
       PE:=FTreeStart;
-      end
     end
   else If (AElement is TPasClassType) then
     begin
@@ -164,8 +162,6 @@ begin
     end;
   If (N<>Nil) then
     begin
-//    if Assigned(PC) then
-//      Writeln(PC.Name,' already in tree');
     Result:=N as TDomElement
    end
   else if AElement.Name<>'' then
@@ -180,10 +176,8 @@ begin
       end;
     if PE=Nil then
       begin
-      //Writeln('PE = nil detected for ',AElement.PathName);
       PE:=FTreeStart
       end;
-    //Writeln('Appending to ',PE.NodeName);
     // if not assigned, probably needs to be assigned to something else.
     if assigned(PE) then
       PE.AppendChild(Result);

utils/fpdoc/mkfpdoc.pp

@@ -19,6 +19,8 @@ Type
 
   TFPDocCreator = Class(TComponent)
   Private
+    FBaseDescrDir: String;
+    FBaseInputDir: String;
     FCurPackage : TFPDocPackage;
     FProcessedUnits : TStrings;
     FOnLog: TPasParserLogHandler;
@@ -28,7 +30,11 @@ Type
     FVerbose: Boolean;
     function GetOptions: TEngineOptions;
     function GetPackages: TFPDocPackages;
+    procedure SetBaseDescrDir(AValue: String);
+    procedure SetBaseInputDir(AValue: String);
   Protected
+    Function FixInputFile(Const AFileName : String) : String;
+    Function FixDescrFile(Const AFileName : String) : String;
     Procedure DoBeforeEmitNote(Sender : TObject; Note : TDomElement; Var EmitNote : Boolean); virtual;
     procedure HandleOnParseUnit(Sender: TObject; const AUnitName: String; out AInputFile, OSTarget, CPUTarget: String);
     procedure SetVerbose(AValue: Boolean); virtual;
@@ -49,6 +55,9 @@ Type
     // Easy access
     Property Options : TEngineOptions Read GetOptions;
     Property Packages : TFPDocPackages Read GetPackages;
+    // When set, they will be prepended to non-absolute filenames.
+    Property BaseInputDir : String Read FBaseInputDir Write SetBaseInputDir;
+    Property BaseDescrDir : String Read FBaseDescrDir Write SetBaseDescrDir;
   end;
 
 implementation
@@ -72,13 +81,13 @@ begin
     end;
 end;
 
-procedure TFPDocCreator.DoLog(const Msg: String);
+Procedure TFPDocCreator.DoLog(Const Msg: String);
 begin
   If Assigned(OnLog) then
     OnLog(Self,Msg);
 end;
 
-procedure TFPDocCreator.DoLog(const Fmt: String; Args: array of const);
+procedure TFPDocCreator.DoLog(Const Fmt: String; Args: Array of Const);
 begin
   DoLog(Format(Fmt,Args));
 end;
@@ -103,7 +112,7 @@ begin
        SplitInputFIleOption(S,UN,Opts);
        if CompareText(ChangeFileExt(ExtractFileName(Un),''),AUnitName)=0 then
          begin
-         AInputFile:=S;
+         AInputFile:=FixInputFile(UN)+' '+Opts;
          OSTarget:=FProject.Options.OSTarget;
          CPUTarget:=FProject.Options.CPUTarget;
          FProcessedUnits.Add(UN);
@@ -123,13 +132,45 @@ begin
   Result:=FProject.Packages;
 end;
 
-procedure TFPDocCreator.DoBeforeEmitNote(Sender: TObject; Note: TDomElement;
-  var EmitNote: Boolean);
+Function TFPDocCreator.FixInputFile(Const AFileName: String): String;
+begin
+  Result:=AFileName;
+  If Result='' then exit;
+  if (ExtractFileDrive(Result)='') and (Result[1]<>PathDelim) then
+    Result:=BaseInputDir+Result;
+end;
+
+Function TFPDocCreator.FixDescrFile(Const AFileName: String): String;
+begin
+  Result:=AFileName;
+  If Result='' then exit;
+  if (ExtractFileDrive(Result)='') and (Result[1]<>PathDelim) then
+    Result:=BaseDescrDir+Result;
+end;
+
+procedure TFPDocCreator.SetBaseDescrDir(AValue: String);
+begin
+  if FBaseDescrDir=AValue then Exit;
+  FBaseDescrDir:=AValue;
+  If FBaseDescrDir<>'' then
+    FBaseDescrDir:=IncludeTrailingPathDelimiter(FBaseDescrDir);
+end;
+
+procedure TFPDocCreator.SetBaseInputDir(AValue: String);
+begin
+  if FBaseInputDir=AValue then Exit;
+  FBaseInputDir:=AValue;
+  If FBaseInputDir<>'' then
+    FBaseInputDir:=IncludeTrailingPathDelimiter(FBaseInputDir);
+end;
+
+Procedure TFPDocCreator.DoBeforeEmitNote(Sender: TObject; Note: TDomElement;
+  Var EmitNote: Boolean);
 begin
   EmitNote:=True;
 end;
 
-constructor TFPDocCreator.Create(AOwner: TComponent);
+Constructor TFPDocCreator.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FProject:=TFPDocProject.Create(Self);
@@ -139,7 +180,7 @@ begin
   FProcessedUnits:=TStringList.Create;
 end;
 
-destructor TFPDocCreator.Destroy;
+Destructor TFPDocCreator.Destroy;
 begin
   FreeAndNil(FProcessedUnits);
   FreeAndNil(FProject);
@@ -180,7 +221,8 @@ begin
     Engine.WriteContentFile(APackage.ContentFile);
 end;
 
-procedure TFPDocCreator.CreateDocumentation(APackage: TFPDocPackage; ParseOnly : Boolean);
+Procedure TFPDocCreator.CreateDocumentation(APackage: TFPDocPackage;
+  ParseOnly: Boolean);
 
 var
   i,j: Integer;
@@ -201,7 +243,7 @@ begin
       Engine.ReadContentFile(Arg, Cmd);
       end;
     for i := 0 to APackage.Descriptions.Count - 1 do
-      Engine.AddDocFile(APackage.Descriptions[i],Options.donttrim);
+      Engine.AddDocFile(FixDescrFile(APackage.Descriptions[i]),Options.donttrim);
     Engine.SetPackageName(APackage.Name);
     Engine.Output:=APackage.Output;
     Engine.OnLog:=Self.OnLog;
@@ -216,10 +258,11 @@ begin
     for i := 0 to APackage.Inputs.Count - 1 do
       try
         SplitInputFileOption(APackage.Inputs[i],Cmd,Arg);
+        Cmd:=FixInputFIle(Cmd);
         if FProcessedUnits.IndexOf(Cmd)=-1 then
           begin
           FProcessedUnits.Add(Cmd);
-          ParseSource(Engine, APackage.Inputs[i], Options.OSTarget, Options.CPUTarget);
+          ParseSource(Engine,Cmd+' '+Arg, Options.OSTarget, Options.CPUTarget);
           end;
       except
         on e: EParserError do
@@ -239,7 +282,7 @@ begin
   end;
 end;
 
-procedure TFPDocCreator.CreateProjectFile(Const AFileName: string);
+Procedure TFPDocCreator.CreateProjectFile(Const AFileName: string);
 begin
   With TXMLFPDocOptions.Create(Self) do
   try
@@ -249,7 +292,7 @@ begin
   end;
 end;
 
-procedure TFPDocCreator.LoadProjectFile(const AFileName: string);
+Procedure TFPDocCreator.LoadProjectFile(Const AFileName: string);
 begin
   With TXMLFPDocOptions.Create(self) do
     try