pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3611 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-09-29 22:27:03 +00:00
parent 72a9ffc042
commit 5b4317a706
8 changed files with 165 additions and 58 deletions
Download Patch File Download Diff File Expand all files Collapse all files

125
components/fpspreadsheet/examples/wikitablemaker/synhighlighterwikitable.pas
View File

@ -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;
@ -434,16 +417,16 @@ end;
function TSynWikiTableSyn.GetTokenAttribute: TSynHighlighterAttributes;
begin
case GetTokenID of
tkComment : Result := FCommentAttri;
tkSymbol : Result := FSymbolAttri;
tkNumber : Result := FNumberAttri;
tkSpace : Result := FSpaceAttri;
tkComment : Result := FCommentAttri;
tkSymbol : Result := FSymbolAttri;
tkNumber : Result := FNumberAttri;
tkSpace : Result := FSpaceAttri;
tkIdentifier : Result := FIdentifierAttri;
tkString : Result := FStringAttri;
{
tkIdentifier: Result := FIdentifierAttri;
tkKey : Result := FKeyAttri;
tkNumber : Result := FNumberAttri;
tkString : Result := FStringAttri;
tkUnknown : Result := FIdentifierAttri;
tkKey : Result := FKeyAttri;
tkNumber : Result := FNumberAttri;
tkUnknown : Result := FIdentifierAttri;
}
else
Result := nil;
@ -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;

3
components/fpspreadsheet/examples/wikitablemaker/wtmain.lfm
View File

@ -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

2
components/fpspreadsheet/examples/wikitablemaker/wtmain.pas
View File

@ -593,7 +593,7 @@ begin
// Create the syntax highlighter
FHighlighter := TSynWikitableSyn.Create(self);
SynEdit.Highlighter := FHighlighter;
// SynEdit.Highlighter := SynCSSSyn1;
//SynEdit.Highlighter := SynCSSSyn1;
// Adjust format toolbar height, looks strange at 120 dpi
//FormatToolbar.Height := FontCombobox.Height + 2*FontCombobox.Top;

18
components/fpspreadsheet/fpsopendocument.pas
View File

@ -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,

35
components/fpspreadsheet/fpsutils.pas
View File

@ -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;
{******************************************************************************}
{******************************************************************************}

18
components/fpspreadsheet/tests/errortests.pas
View File

@ -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;

12
components/fpspreadsheet/wikitable.pas
View File

@ -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 := '&nbsp;';
// if lCurStr = '' then lCurStr := '&nbsp;';
// Check for invalid characters
if not ValidXMLText(lCurStr, false) then
Workbook.AddErrorMsg(
'Invalid character(s) in cell %s.', [
GetCellString(i, j)
]);
lStyleStr := '';
lColSpanStr := '';
lRowSpanStr := '';

10
components/fpspreadsheet/xlsxooxml.pas
View File

@ -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);