read user-defined compiler messages in source codepage

compiler/scandir.pas

@@ -143,7 +143,7 @@ unit scandir;
     procedure do_message(w:integer);
       begin
         current_scanner.skipspace;
-        Message1(w,current_scanner.readcomment);
+        Message1(w,current_scanner.readlongcomment);
       end;
 
 
@@ -934,6 +934,7 @@ unit scandir;
     procedure dir_message;
       var
         hs : string;
+        s  : AnsiString;
         w  : longint;
       begin
         w:=0;
@@ -969,10 +970,10 @@ unit scandir;
           begin
             current_scanner.skipspace;
             if c='''' then
-              hs:=current_scanner.readquotedstring
+              s:=current_scanner.readlongquotedstring
             else
-              hs:=current_scanner.readcomment;
-            Message1(w,hs);
+              s:=current_scanner.readlongcomment;
+            Message1(w,s);
           end
         else
           current_scanner.readcomment;

compiler/scanner.pas

@@ -249,6 +249,8 @@ interface
           function  readval64:int64;
           function  readcomment(include_special_char: boolean = false):string;
           function  readquotedstring:string;
+          function  readlongcomment(include_special_char: boolean = false):RawByteString;
+          function  readlongquotedstring:RawByteString;
           function  readstate:char;
           function  readoptionalstate(fallback:char):char;
           function  readstatedefault:char;
@@ -4843,6 +4845,126 @@ type
       end;
 
 
+    function tscannerfile.readlongcomment(include_special_char: boolean):RawByteString;
+      var
+        i : longint;
+
+        procedure addchar(char: AnsiChar = #0);
+        begin
+          Inc(i);
+          if Length(readlongcomment)>=i then
+            SetLength(readlongcomment, Length(readlongcomment)+256);
+          if char<>#0 then
+            readlongcomment[i]:=char
+          else
+            readlongcomment[i]:=c;
+        end;
+      begin
+        i:=0;
+        SetLength(readlongcomment, 256);
+        repeat
+          case c of
+            '{' :
+              begin
+                if (include_special_char) then
+                  addchar;
+
+                if current_commentstyle=comment_tp then
+                  inc_comment_level;
+              end;
+            '}' :
+              begin
+                if (include_special_char) then
+                  addchar;
+
+                if current_commentstyle=comment_tp then
+                  begin
+                    readchar;
+                    dec_comment_level;
+
+
+                    if comment_level=0 then
+                      break
+                    else
+                      continue;
+                  end;
+              end;
+            '*' :
+              begin
+                if current_commentstyle=comment_oldtp then
+                  begin
+                    readchar;
+                    if c=')' then
+                      begin
+                        readchar;
+                        dec_comment_level;
+                        break;
+                      end
+                    else
+                    { Add both characters !!}
+                      begin
+                        addchar('*');
+                        addchar;
+                      end;
+                  end
+                else
+                { Not old TP comment, so add...}
+                  addchar('*');
+              end;
+            #10,#13 :
+              linebreak;
+            #26 :
+              end_of_file;
+            else
+              addchar;
+          end;
+          readchar;
+        until false;
+        SetLength(readlongcomment, i);
+        SetCodePage(readlongcomment, current_settings.sourcecodepage, False);
+      end;
+
+
+    function tscannerfile.readlongquotedstring:RawByteString;
+      var
+        i : longint;
+        msgwritten : boolean;
+
+        procedure addchar;
+        begin
+          Inc(i);
+          if Length(readlongquotedstring)>=i then
+            SetLength(readlongquotedstring, Length(readlongquotedstring)+256);
+          readlongquotedstring[i]:=c;
+        end;
+      begin
+        i:=0;
+        Setlength(readlongquotedstring, 256);
+        msgwritten:=false;
+        if (c='''') then
+          begin
+            repeat
+              readchar;
+              case c of
+                #26 :
+                  end_of_file;
+                #10,#13 :
+                  Message(scan_f_string_exceeds_line);
+                '''' :
+                  begin
+                    readchar;
+                    if c<>'''' then
+                     break;
+                  end;
+              end;
+              addchar;
+            until false;
+          end;
+        SetLength(readlongquotedstring, i);
+        SetCodePage(readlongquotedstring, current_settings.sourcecodepage, False);
+      end;
+
+
     function tscannerfile.readstate:char;
       var
         state : char;