* Patch from Mattias gaertner to support lazarus lfm encoding in TParser

git-svn-id: trunk@15415 -

rtl/objpas/classes/classes.inc

@@ -842,7 +842,7 @@ begin
     end;
 end;
 
-procedure ObjectBinaryToText(Input, Output: TStream);
+procedure ObjectBinaryToText(Input, Output: TStream; Encoding: TObjectTextEncoding);
 
   procedure OutStr(s: String);
   begin
@@ -855,7 +855,8 @@ procedure ObjectBinaryToText(Input, Output: TStream);
     OutStr(s + LineEnding);
   end;
 
-  procedure Outchars(P, LastP : Pointer; CharToOrdFunc: CharToOrdFuncty);
+  procedure Outchars(P, LastP : Pointer; CharToOrdFunc: CharToOrdFuncty;
+    UseBytes: boolean = false);
 
   var
     res, NewStr: String;
@@ -879,8 +880,8 @@ procedure ObjectBinaryToText(Input, Output: TStream);
           NewInString := True;
         NewStr := '''''';
         end 
-      else if (Ord(w) >= 32) and (Ord(w) < 127) then 
-        begin //printable ascii
+      else if (Ord(w) >= 32) and ((Ord(w) < 127) or (UseBytes and (Ord(w)<256))) then
+        begin //printable ascii or bytes
         if not InString then
           NewInString := True;
         NewStr := char(w);
@@ -906,7 +907,7 @@ procedure ObjectBinaryToText(Input, Output: TStream);
 
   procedure OutString(s: String);
   begin
-    OutChars(Pointer(S),PChar(S)+Length(S),@CharToOrd);
+    OutChars(Pointer(S),PChar(S)+Length(S),@CharToOrd,Encoding=oteLFM);
   end;
 
   procedure OutWString(W: WideString);
@@ -921,7 +922,10 @@ procedure ObjectBinaryToText(Input, Output: TStream);
 
   procedure OutUtf8Str(s: String);
   begin
-    OutChars(Pointer(S),PChar(S)+Length(S),@Utf8ToOrd);
+    if Encoding=oteLFM then
+      OutChars(Pointer(S),PChar(S)+Length(S),@CharToOrd)
+    else
+      OutChars(Pointer(S),PChar(S)+Length(S),@Utf8ToOrd);
   end;
 
   function ReadWord : word; {$ifdef CLASSESINLINE}inline;{$endif CLASSESINLINE}
@@ -1260,6 +1264,10 @@ begin
   ReadObject('');
 end;
 
+procedure ObjectBinaryToText(Input, Output: TStream);
+begin
+  ObjectBinaryToText(Input,Output,oteDFM);
+end;
 
 procedure ObjectTextToBinary(Input, Output: TStream);
 var

rtl/objpas/classes/classesh.inc

@@ -1423,7 +1423,8 @@ type
     procedure HandleNumber;
     procedure HandleHexNumber;
     function HandleQuotedString : string;
-    function HandleDecimalString(var ascii : boolean) : widestring;
+    procedure HandleDecimalCharacter(var ascii : boolean;
+                                     out WideChr: widechar; out StringChr: char);
     procedure HandleString;
     procedure HandleMinus;
     procedure HandleUnknown;
@@ -1973,6 +1974,13 @@ function CollectionsEqual(C1, C2: TCollection; Owner1, Owner2: TComponent): Bool
 
 { Object conversion routines }
 
+type
+  TObjectTextEncoding = (
+    oteDFM,
+    oteLFM
+    );
+
+procedure ObjectBinaryToText(Input, Output: TStream; Encoding: TObjectTextEncoding);
 procedure ObjectBinaryToText(Input, Output: TStream);
 procedure ObjectTextToBinary(Input, Output: TStream);
 

rtl/objpas/classes/parser.inc

@@ -249,41 +249,64 @@ begin
   end;
 end;
 
-function TParser.HandleDecimalString(var ascii : boolean): widestring;
+procedure TParser.HandleDecimalCharacter(var ascii: boolean; out
+  WideChr: widechar; out StringChr: char);
 var i : integer;
 begin
-  Result:='';
   inc(fPos);
   CheckLoadBuffer;
-  while IsNumber do
+  // read a word number
+  i:=0;
+  while IsNumber and (i<high(word)) do
   begin
-    Result:=Result+fBuf[fPos];
+    i:=i*10+ord(fBuf[fPos])-ord('0');
     inc(fPos);
     CheckLoadBuffer;
   end;
-  if not TryStrToInt(Result,i) then
-  i:=0;
+  if i>high(word) then i:=0;
   if i>127 then ascii:=false;
-  setlength(Result,1);
-  Result[1]:=widechar(word(i));
+  WideChr:=widechar(word(i));
+  if i<256 then
+    StringChr:=chr(i)
+  else
+    StringChr:=#0;
 end;
 
 procedure TParser.HandleString;
 var ascii : boolean;
+  s: string;
+  w: WideChar;
+  c: char;
 begin
   fLastTokenWStr:='';
+  fLastTokenStr:='';
   ascii:=true;
   while true do
+  begin
     case fBuf[fPos] of
-      '''' : fLastTokenWStr:=fLastTokenWStr+HandleQuotedString;
-      '#'  : fLastTokenWStr:=fLastTokenWStr+HandleDecimalString(ascii)
+      '''' :
+        begin
+          // avoid conversions,
+          // On some systems conversion from ansistring to widestring and back
+          // to ansistring does not give the original ansistring.
+          // See bug http://bugs.freepascal.org/view.php?id=15841
+          s:=HandleQuotedString;
+          fLastTokenWStr:=fLastTokenWStr+s;
+          fLastTokenStr:=fLastTokenStr+s;
+        end;
+      '#'  :
+        begin
+          HandleDecimalCharacter(ascii,w,c);
+          fLastTokenWStr:=fLastTokenWStr+w;
+          fLastTokenStr:=fLastTokenStr+c;
+        end;
       else break;
     end;
+  end;
   if ascii then
     fToken:=Classes.toString
   else
     fToken:=toWString;
-  fLastTokenStr:=fLastTokenWStr;
 end;
 
 procedure TParser.HandleMinus;