* Add OnComment

git-svn-id: trunk@45415 -

packages/fcl-passrc/src/pscanner.pp

@@ -684,8 +684,8 @@ type
   TPScannerLogHandler = Procedure (Sender : TObject; Const Msg : String) of object;
   TPScannerLogEvent = (sleFile,sleLineNumber,sleConditionals,sleDirective);
   TPScannerLogEvents = Set of TPScannerLogEvent;
-  TPScannerDirectiveEvent = procedure(Sender: TObject; Directive, Param: String;
-    var Handled: boolean) of object;
+  TPScannerDirectiveEvent = procedure(Sender: TObject; Directive, Param: String; var Handled: boolean) of object;
+  TPScannerCommentEvent = procedure(Sender: TObject; aComment : String) of object;
   TPScannerFormatPathEvent = function(const aPath: string): string of object;
   TPScannerWarnEvent = procedure(Sender: TObject; Identifier: string; State: TWarnMsgState; var Handled: boolean) of object;
   TPScannerModeDirective = procedure(Sender: TObject; NewMode: TModeSwitch; Before: boolean; var Handled: boolean) of object;
@@ -734,6 +734,7 @@ type
     FMacros: TStrings; // Objects are TMacroDef
     FDefines: TStrings;
     FNonTokens: TTokens;
+    FOnComment: TPScannerCommentEvent;
     FOnDirective: TPScannerDirectiveEvent;
     FOnEvalFunction: TCEEvalFunctionEvent;
     FOnEvalVariable: TCEEvalVarEvent;
@@ -799,6 +800,7 @@ type
     function HandleDirective(const ADirectiveText: String): TToken; virtual;
     function HandleLetterDirective(Letter: char; Enable: boolean): TToken; virtual;
     procedure HandleBoolDirective(bs: TBoolSwitch; const Param: String); virtual;
+    procedure DoHandleComment(Sender: TObject; const aComment : string); virtual;
     procedure DoHandleDirective(Sender: TObject; Directive, Param: String;
       var Handled: boolean); virtual;
     procedure HandleIFDEF(const AParam: String);
@@ -882,7 +884,6 @@ type
     property Defines: TStrings read FDefines;
     property Macros: TStrings read FMacros;
     property MacrosOn: boolean read GetMacrosOn write SetMacrosOn;
-    property OnDirective: TPScannerDirectiveEvent read FOnDirective write FOnDirective;
     property AllowedModeSwitches: TModeSwitches read FAllowedModeSwitches Write SetAllowedModeSwitches;
     property ReadOnlyModeSwitches: TModeSwitches read FReadOnlyModeSwitches Write SetReadOnlyModeSwitches;// always set, cannot be disabled
     property CurrentModeSwitches: TModeSwitches read FCurrentModeSwitches Write SetCurrentModeSwitches;
@@ -908,6 +909,9 @@ type
     property OnEvalFunction: TCEEvalFunctionEvent read FOnEvalFunction write FOnEvalFunction;
     property OnWarnDirective: TPScannerWarnEvent read FOnWarnDirective write FOnWarnDirective;
     property OnModeChanged: TPScannerModeDirective read FOnModeChanged write FOnModeChanged; // set by TPasParser
+    property OnDirective: TPScannerDirectiveEvent read FOnDirective write FOnDirective;
+    property OnComment: TPScannerCommentEvent read FOnComment write FOnComment;
+
 
     property LastMsg: string read FLastMsg write FLastMsg;
     property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
@@ -4094,11 +4098,17 @@ begin
     CurrentBoolSwitches:=CurrentBoolSwitches-[bs];
 end;
 
+procedure TPascalScanner.DoHandleComment(Sender: TObject; const aComment: string);
+begin
+  if Assigned(OnComment) then
+    OnComment(Sender,aComment);
+end;
+
 procedure TPascalScanner.DoHandleDirective(Sender: TObject; Directive,
   Param: String; var Handled: boolean);
 begin
   if Assigned(OnDirective) then
-    OnDirective(Self,Directive,Param,Handled);
+    OnDirective(Sender,Directive,Param,Handled);
 end;
 
 function TPascalScanner.DoFetchToken: TToken;
@@ -4299,7 +4309,9 @@ begin
         Inc(FTokenPos, 2);
         Result := tkComment;
         if Copy(CurTokenString,1,1)='$' then
-          Result := HandleDirective(CurTokenString);
+          Result := HandleDirective(CurTokenString)
+        else
+          DoHandleComment(Self,CurTokenString);
         end;
       end;
     ')':
@@ -4600,7 +4612,9 @@ begin
       Inc(FTokenPos);
       Result := tkComment;
       if (Copy(CurTokenString,1,1)='$') then
-        Result:=HandleDirective(CurTokenString);
+        Result:=HandleDirective(CurTokenString)
+      else
+        DoHandleComment(Self, CurTokenString)
       end;
     'A'..'Z', 'a'..'z', '_':
       begin

packages/fcl-passrc/tests/tcscanner.pas

@@ -55,7 +55,10 @@ type
     FLI: String;
     FScanner : TPascalScanner;
     FResolver : TStreamResolver;
+    FDoCommentCalled : Boolean;
+    FComment: string;
   protected
+    procedure DoComment(Sender: TObject; aComment: String);
     procedure SetUp; override;
     procedure TearDown; override;
     Function TokenToString(tk : TToken) : string;
@@ -82,6 +85,7 @@ type
     procedure TestNestedComment3;
     procedure TestNestedComment4;
     procedure TestNestedComment5;
+    procedure TestonComment;
     procedure TestIdentifier;
     procedure TestSelf;
     procedure TestSelfNoToken;
@@ -369,8 +373,15 @@ end;
   TTestScanner
   ---------------------------------------------------------------------}
 
+procedure TTestScanner.DoComment(Sender: TObject; aComment: String);
+begin
+  FDoCommentCalled:=True;
+  FComment:=aComment;
+end;
+
 procedure TTestScanner.SetUp;
 begin
+  FDoCommentCalled:=False;
   FResolver:=TStreamResolver.Create;
   FResolver.OwnsStreams:=True;
   FScanner:=TTestingPascalScanner.Create(FResolver);
@@ -571,6 +582,15 @@ begin
   TestToken(tkComment,'(* (* comment *) *)');
 end;
 
+procedure TTestScanner.TestonComment;
+begin
+  FScanner.OnComment:=@DoComment;
+  DoTestToken(tkComment,'(* abc *)',False);
+  assertTrue('Comment called',FDoCommentCalled);
+  AssertEquals('Correct comment',' abc ',Scanner.CurTokenString);
+  AssertEquals('Correct comment token',' abc ',FComment);
+end;
+
 
 procedure TTestScanner.TestIdentifier;