fpspreadsheet: Fix writing non-printable characters writing to xml-like formats (xlsx, ods, wikitable). Add test case to error tests. Improve syntaxhighlighter for wikitablemaker demo (still not perfect).

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3611 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/examples/wikitablemaker/synhighlighterwikitable.pas

@@ -44,11 +44,11 @@ type
     FNumberAttri: TSynHighlighterAttributes;
     FSpaceAttri: TSynHighlighterAttributes;
     FSymbolAttri: TSynHighlighterAttributes;
-    (*
     FIdentifierAttri: TSynHighlighterAttributes;
+    FStringAttri: TSynHighlighterAttributes;
+    (*
     FKeyAttri: TSynHighlighterAttributes;
     FNumberAttri: TSynHighlighterAttributes;
-    FStringAttri: TSynHighlighterAttributes;
     *)
     procedure InitIdent;
     function IdentKind(MayBe: PChar): TtkTokenKind;
@@ -59,13 +59,13 @@ type
     procedure AmpersandProc;
     procedure BarProc;
     procedure BeginProc;
-    procedure CommentProc;
     procedure CRProc;
     procedure ExclamProc;
     procedure LFProc;
     procedure IdentProc;
     procedure NullProc;
     procedure NumberProc;
+    procedure OpenBraceProc;
     procedure SpaceProc;
     procedure StringProc;
     procedure TextProc;
@@ -86,10 +86,14 @@ type
   published
     property CommentAttri: TSynHighlighterAttributes
       read FCommentAttri write FCommentAttri;
+    property IdentifierAttri: TSynHighlighterAttributes
+      read FIdentifierAttri write FIdentifierAttri;
     property NumberAttri: TSynHighlighterAttributes
       read FNumberAttri write FNumberAttri;
     property SpaceAttri: TSynHighlighterAttributes
       read FSpaceAttri write FSpaceAttri;
+    property StringAttri: TSynHighlighterAttributes
+      read FStringAttri write FStringAttri;
     property SymbolAttri: TSynHighlighterAttributes
       read FSymbolAttri write FSymbolAttri;
 
@@ -312,16 +316,19 @@ begin
   FSymbolAttri.Foreground := clPurple;
   AddAttribute(fSymbolAttri);
 
-  (*
+  FIdentifierAttri := TSynHighlighterAttributes.Create(@SYNS_AttrIdentifier, SYNS_XML_AttrIdentifier);
-  fIdentifierAttri := TSynHighlighterAttributes.Create(@SYNS_AttrIdentifier, SYNS_XML_AttrIdentifier);
+  FIdentifierAttri.Foreground := clNavy;
+  FIdentifierAttri.Style := [fsBold];
   AddAttribute(fIdentifierAttri);
 
+  FStringAttri := TSynHighlighterAttributes.Create(@SYNS_AttrString, SYNS_XML_AttrString);
+  FStringAttri.Foreground := clOlive;
+  AddAttribute(FStringAttri);
+   (*
   fKeyAttri := TSynHighlighterAttributes.Create(@SYNS_AttrKey, SYNS_XML_AttrKey);
   fKeyAttri.Style := [fsBold];
   AddAttribute(fKeyAttri);
 
-  fStringAttri := TSynHighlighterAttributes.Create(@SYNS_AttrString, SYNS_XML_AttrString);
-  AddAttribute(fStringAttri);
   *)
 
   SetAttributesOnChange(@DefHighlightChange);
@@ -362,30 +369,6 @@ begin
   end;
 end;
 
-procedure TSynWikitableSyn.CommentProc;
-begin
-  FTokenID := tkComment;
-
-  if (FLine[Run] in [#0, #10, #13]) then begin
-    FProcTable[FLine[Run]];
-    Exit;
-  end;
-
-  while not (FLine[Run] in [#0, #10, #13]) do begin
-    if (FLine[Run] = '>') and (FLine[Run - 1] = '-') and (FLine[Run - 2] = '-')
-    then begin
-      FRange := rsText;
-      inc(Run);
-      {
-      if TopHtmlCodeFoldBlockType = cfbtHtmlComment then
-        EndHtmlNodeCodeFoldBlock;
-        }
-      break;
-    end;
-    inc(Run);
-  end;
-end;
-
 procedure TSynWikiTableSyn.CRProc;
 begin
   FTokenID := tkSpace;
@@ -407,10 +390,10 @@ begin
     SYN_ATTR_SYMBOL     : Result := FSymbolAttri;
     SYN_ATTR_NUMBER     : Result := FNumberAttri;
     SYN_ATTR_WHITESPACE : Result := FSpaceAttri;
-    (*
     SYN_ATTR_IDENTIFIER : Result := FIdentifierAttri;
-    SYN_ATTR_KEYWORD    : Result := FKeyAttri;
     SYN_ATTR_STRING     : Result := FStringAttri;
+    (*
+    SYN_ATTR_KEYWORD    : Result := FKeyAttri;
     *)
   else
     Result := nil;
@@ -438,11 +421,11 @@ begin
     tkSymbol     : Result := FSymbolAttri;
     tkNumber     : Result := FNumberAttri;
     tkSpace      : Result := FSpaceAttri;
-    {
     tkIdentifier : Result := FIdentifierAttri;
+    tkString     : Result := FStringAttri;
+    {
     tkKey        : Result := FKeyAttri;
     tkNumber     : Result := FNumberAttri;
-    tkString    : Result := FStringAttri;
     tkUnknown    : Result := FIdentifierAttri;
     }
   else
@@ -479,7 +462,7 @@ begin
   FToIdent := MayBe;
   HashKey := KeyHash(MayBe);
   if (HashKey >= 16) and (HashKey <= 275) then
-    Result := fIdentFuncTable[HashKey]()
+    Result := FIdentFuncTable[HashKey]()
   else
     Result := tkIdentifier;
 end;
@@ -574,7 +557,7 @@ begin
       '0'..'9'                    : FProcTable[ch] := @NumberProc;
       'A'..'Z', 'a'..'z', '_','@' : FProcTable[ch] := @IdentProc;
       '&'                         : FProcTable[ch] := @AmpersandProc;
-      '<'                         : FProcTable[ch] := @CommentProc;
+      '<'                         : FProcTable[ch] := @OpenBraceProc;
       '{'                         : FProcTable[ch] := @BeginProc;
       '|'                         : FProcTable[ch] := @BarProc;
       '!'                         : FProcTable[ch] := @ExclamProc;
@@ -621,7 +604,7 @@ begin
   FTokenPos := Run;
   case FRange of
     rsText    : TextProc;
-    rsComment : CommentProc;
+    rsComment : OpenBraceProc;
     else        FProcTable[FLine[Run]];
   end;
 
@@ -651,6 +634,58 @@ begin
   end;
 end;
 
+procedure TSynWikitableSyn.OpenBraceProc;
+begin
+  if (FLine[Run+1] = '!') and (FLine[Run+2] = '-') and (FLine[Run+3] = '-') then
+  begin
+    FTokenID := tkComment;
+    while not (FLine[Run] in [#0, #10, #13]) do begin
+      if (FLine[Run] = '>') and (FLine[Run - 1] = '-') and (FLine[Run - 2] = '-')
+      then begin
+        FRange := rsText;
+        inc(Run);
+        {
+        if TopHtmlCodeFoldBlockType = cfbtHtmlComment then
+          EndHtmlNodeCodeFoldBlock;
+          }
+        break;
+      end;
+      inc(Run);
+    end;
+  end else begin
+    FTokenID := tkSymbol;
+    while not (FLine[Run] in [#0, #10, #13]) do begin
+      if FLine[Run] = '>' then begin
+        FRange := rsText;
+        inc(Run);
+        break;
+      end;
+      inc(Run);
+    end;
+  end;
+
+(*
+  if (FLine[Run] in [#0, #10, #13]) then begin
+    FProcTable[FLine[Run]];
+    Exit;
+  end;
+
+  while not (FLine[Run] in [#0, #10, #13]) do begin
+    if (FLine[Run] = '>') and (FLine[Run - 1] = '-') and (FLine[Run - 2] = '-')
+    then begin
+      FRange := rsText;
+      inc(Run);
+      {
+      if TopHtmlCodeFoldBlockType = cfbtHtmlComment then
+        EndHtmlNodeCodeFoldBlock;
+        }
+      break;
+    end;
+    inc(Run);
+  end;
+  *)
+end;
+
 procedure TSynWikiTableSyn.SetLine(const NewValue: String; LineNumber: Integer);
 begin
   inherited;

components/fpspreadsheet/examples/wikitablemaker/wtmain.lfm

@@ -717,7 +717,6 @@ object MainFrm: TMainFrm
           ''
         )
         VisibleSpecialChars = [vscSpace, vscTabAtLast]
-        ReadOnly = True
         SelectedColor.FrameEdges = sfeAround
         SelectedColor.BackPriority = 50
         SelectedColor.ForePriority = 50
@@ -3794,7 +3793,9 @@ object MainFrm: TMainFrm
     DefaultFilter = 'Cascading Stylesheets (*.css)|*.css'
     Enabled = False
     CommentAttri.FrameEdges = sfeAround
+    IdentifierAttri.Foreground = clOlive
     IdentifierAttri.FrameEdges = sfeAround
+    IdentifierAttri.Style = [fsBold]
     KeyAttri.FrameEdges = sfeAround
     NumberAttri.Foreground = clFuchsia
     NumberAttri.FrameEdges = sfeAround

components/fpspreadsheet/fpsopendocument.pas

@@ -3786,6 +3786,7 @@ var
   rowsSpannedStr: String;
   spannedStr: String;
   r1,c1,r2,c2: Cardinal;
+  str: ansistring;
 begin
   Unused(AStream, ACell);
   Unused(ARow, ACol);
@@ -3806,19 +3807,22 @@ begin
   end else
     spannedStr := '';
 
+  // Check for invalid characters
+  str := AValue;
+  if not ValidXMLText(str) then
+    Workbook.AddErrorMsg(
+      'Invalid character(s) in cell %s.', [
+      GetCellString(ARow, ACol)
+    ]);
+
+  // Write it ...
   AppendToStream(AStream, Format(
     '<table:table-cell office:value-type="string" %s %s>' +
       '<text:p>%s</text:p>'+
     '</table:table-cell>', [
     lStyle, spannedStr,
-    UTF8TextToXMLText(AValue)
+    str
   ]));
-      {
-  AppendToStream(AStream,
-    '<table:table-cell office:value-type="string"' + lStyle + '>' +
-      '<text:p>' + UTF8TextToXMLText(AValue) + '</text:p>' +
-    '</table:table-cell>');
-    }
 end;
 
 procedure TsSpreadOpenDocWriter.WriteNumber(AStream: TStream; const ARow,

components/fpspreadsheet/fpsutils.pas

@@ -135,6 +135,8 @@ function HTMLLengthStrToPts(AValue: String): Double;
 function HTMLColorStrToColor(AValue: String): TsColorValue;
 function ColorToHTMLColorStr(AValue: TsColorValue; AExcelDialect: Boolean = false): String;
 function UTF8TextToXMLText(AText: ansistring): ansistring;
+function ValidXMLText(var AText: ansistring; ReplaceSpecialChars: Boolean = true): Boolean;
+
 function TintedColor(AColor: TsColorValue; tint: Double): TsColorValue;
 function HighContrastColor(AColorValue: TsColorValue): TsColor;
 
@@ -1576,6 +1578,39 @@ begin
   Result:=WrkStr;
 end;
 
+{@@ ----------------------------------------------------------------------------
+  Checks a string for characters that are not permitted in XML strings.
+  The function returns FALSE if a character <#32 is contained (except for
+  #9, #10, #13), TRUE otherwise. Invalid characters are replaced by a box symbol.
+
+  If ReplaceSpecialChars is TRUE, some other characters are converted
+  to valid HTML codes by calling UTF8TextToXMLText
+
+  @param  AText                String to be checked. Is replaced by valid string.
+  @param  ReplaceSpecialChars  Special characters are replaced by their HTML
+                               codes (e.g. '>' --> '&gt;')
+  @return FALSE if characters < #32 were replaced, TRUE otherwise.
+-------------------------------------------------------------------------------}
+function ValidXMLText(var AText: ansistring;
+  ReplaceSpecialChars: Boolean = true): Boolean;
+const
+  BOX = #$E2#$8E#$95;
+var
+  i: Integer;
+begin
+  Result := true;
+  for i := Length(AText) downto 1 do
+    if (AText[i] < #32) and not (AText[i] in [#9, #10, #13]) then begin
+      // Replace invalid character by box symbol
+      Delete(AText, i, 1);
+      Insert(BOX, AText, i);
+//      AText[i] := '?';
+      Result := false;
+    end;
+  if ReplaceSpecialChars then
+    AText := UTF8TextToXMLText(AText);
+end;
+
 
 {******************************************************************************}
 {******************************************************************************}

components/fpspreadsheet/tests/errortests.pas

@@ -163,6 +163,24 @@ begin
       end;
     end;
 
+    // Test 5: cell text contains forbidden XML character
+    if (TTestFormat(AFormat) in [sfOOXML, sfOpenDocument]) then begin
+      s := #19'Standard';
+      MyWorkbook := TsWorkbook.Create;
+      try
+        MyWorksheet := MyWorkbook.AddWorksheet(ERROR_SHEET);
+        Myworksheet.WriteUTF8Text(0, 0, s);
+        TempFile := NewTempFile;
+        Myworkbook.WriteToFile(TempFile, AFormat, true);
+        ErrList.Text := MyWorkbook.ErrorMsg;
+        CheckEquals(1, ErrList.Count, 'Error count mismatch in test 5');
+      finally
+        MyWorkbook.Free;
+        DeleteFile(TempFile);
+      end;
+    end else
+      Ignore('Test 5 is no error condition for this format');
+
   finally
     ErrList.Free;
   end;

components/fpspreadsheet/wikitable.pas

@@ -397,7 +397,7 @@ const
   PIPE_CHAR: array[boolean] of String = ('|', '!');
 var
   i, j: cardinal;
-  lCurStr: string = '';
+  lCurStr: ansistring = '';
   lCurUsedFormatting: TsUsedFormattingFields;
   lCurColor: TsColor;
   lStyleStr: String;
@@ -451,7 +451,15 @@ begin
     begin
       lCell := FWorksheet.FindCell(i, j);
       lCurStr := FWorksheet.ReadAsUTF8Text(lCell);
-      if lCurStr = '' then lCurStr := ' ';
+//      if lCurStr = '' then lCurStr := ' ';
+
+      // Check for invalid characters
+      if not ValidXMLText(lCurStr, false) then
+        Workbook.AddErrorMsg(
+          'Invalid character(s) in cell %s.', [
+          GetCellString(i, j)
+        ]);
+
       lStyleStr := '';
       lColSpanStr := '';
       lRowSpanStr := '';

components/fpspreadsheet/xlsxooxml.pas

@@ -170,7 +170,7 @@ type
 implementation
 
 uses
-  variants, fileutil, strutils, math, fpsStreams, fpsNumFormatParser;
+  variants, fileutil, strutils, math, lazutf8, fpsStreams, fpsNumFormatParser;
 
 const
   { OOXML general XML constants }
@@ -2769,9 +2769,15 @@ begin
   else
     ResultingValue:=AValue;
 
+  if not ValidXMLText(ResultingValue) then
+    Workbook.AddErrorMsg(
+      'Invalid character(s) in cell %s.', [
+      GetCellString(ARow, ACol)
+    ]);
+
   AppendToStream(FSSharedStrings,
     '<si>' +
-      '<t>' + UTF8TextToXMLText(ResultingValue) + '</t>' +
+      '<t>' + ResultingValue + '</t>' +
     '</si>');
 
   CellPosText := TsWorksheet.CellPosToText(ARow, ACol);