paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 23:59:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Changed TSpecialCharCallback from method into a regular procedure, this allows to drop all the {$ifdef fpc}@{$endif} ugliness.

Browse Source 
* Also changed TSpecialCharCallback to take the string and the index, so it can process certain sequences, not only single chars.
* In canonical mode, CDATA sections are written as text.

git-svn-id: trunk@13906 -
This commit is contained in:
sergei 2009-10-17 22:09:20 +00:00
parent d709e9d1ab
commit edb79b62e0
1 changed files with 33 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
packages/fcl-xml/src/xmlwrite.pp
View File

@ -40,7 +40,9 @@ implementation
uses SysUtils, xmlutils; uses SysUtils, xmlutils;
type type
TSpecialCharCallback = procedure(c: WideChar) of object; TXMLWriter = class;
TSpecialCharCallback = procedure(Sender: TXMLWriter; const s: DOMString;
var idx: Integer);
PAttrFixup = ^TAttrFixup; PAttrFixup = ^TAttrFixup;
TAttrFixup = record TAttrFixup = record
@ -71,8 +73,6 @@ type
procedure wrtQuotedLiteral(const ws: WideString); procedure wrtQuotedLiteral(const ws: WideString);
procedure ConvWrite(const s: WideString; const SpecialChars: TSetOfChar; procedure ConvWrite(const s: WideString; const SpecialChars: TSetOfChar;
const SpecialCharCallback: TSpecialCharCallback); const SpecialCharCallback: TSpecialCharCallback);
procedure AttrSpecialCharCallback(c: WideChar);
procedure TextNodeSpecialCharCallback(c: WideChar);
procedure WriteNSDef(B: TBinding); procedure WriteNSDef(B: TBinding);
procedure NamespaceFixup(Element: TDOMElement); procedure NamespaceFixup(Element: TDOMElement);
protected protected
@ -329,7 +329,7 @@ begin
if (s[EndPos] < #255) and (Char(ord(s[EndPos])) in SpecialChars) then if (s[EndPos] < #255) and (Char(ord(s[EndPos])) in SpecialChars) then
begin begin
wrtChars(@s[StartPos], EndPos - StartPos); wrtChars(@s[StartPos], EndPos - StartPos);
SpecialCharCallback(s[EndPos]); SpecialCharCallback(Self, s, EndPos);
StartPos := EndPos + 1; StartPos := EndPos + 1;
end; end;
Inc(EndPos); Inc(EndPos);
@ -344,29 +344,31 @@ const
ltStr = '&lt;'; ltStr = '&lt;';
gtStr = '&gt;'; gtStr = '&gt;';
procedure TXMLWriter.AttrSpecialCharCallback(c: WideChar); procedure AttrSpecialCharCallback(Sender: TXMLWriter; const s: DOMString;
var idx: Integer);
begin begin
case c of case s[idx] of
'"': wrtStr(QuotStr); '"': Sender.wrtStr(QuotStr);
'&': wrtStr(AmpStr); '&': Sender.wrtStr(AmpStr);
'<': wrtStr(ltStr); '<': Sender.wrtStr(ltStr);
// Escape whitespace using CharRefs to be consistent with W3 spec § 3.3.3 // Escape whitespace using CharRefs to be consistent with W3 spec § 3.3.3
#9: wrtStr('&#x9;'); #9: Sender.wrtStr('&#x9;');
#10: wrtStr('&#xA;'); #10: Sender.wrtStr('&#xA;');
#13: wrtStr('&#xD;'); #13: Sender.wrtStr('&#xD;');
else else
wrtChr(c); Sender.wrtChr(s[idx]);
end; end;
end; end;
procedure TXMLWriter.TextnodeSpecialCharCallback(c: WideChar); procedure TextnodeSpecialCharCallback(Sender: TXMLWriter; const s: DOMString;
var idx: Integer);
begin begin
case c of case s[idx] of
'<': wrtStr(ltStr); '<': Sender.wrtStr(ltStr);
'>': wrtStr(gtStr); // Required only in ']]>' literal, otherwise optional '>': Sender.wrtStr(gtStr); // Required only in ']]>' literal, otherwise optional
'&': wrtStr(AmpStr); '&': Sender.wrtStr(AmpStr);
else else
wrtChr(c); Sender.wrtChr(s[idx]);
end; end;
end; end;
@ -396,7 +398,7 @@ begin
wrtStr(B.Prefix^.Key); wrtStr(B.Prefix^.Key);
end; end;
wrtChars('="', 2); wrtChars('="', 2);
ConvWrite(B.uri, AttrSpecialChars, {$IFDEF FPC}@{$ENDIF}AttrSpecialCharCallback); ConvWrite(B.uri, AttrSpecialChars, @AttrSpecialCharCallback);
wrtChr('"'); wrtChr('"');
end; end;
@ -531,7 +533,7 @@ begin
wrtChars('="', 2); wrtChars('="', 2);
// TODO: not correct w.r.t. entities // TODO: not correct w.r.t. entities
ConvWrite(attr.nodeValue, AttrSpecialChars, {$IFDEF FPC}@{$ENDIF}AttrSpecialCharCallback); ConvWrite(attr.nodeValue, AttrSpecialChars, @AttrSpecialCharCallback);
wrtChr('"'); wrtChr('"');
end; end;
end; end;
@ -584,16 +586,21 @@ end;
procedure TXMLWriter.VisitText(node: TDOMNode); procedure TXMLWriter.VisitText(node: TDOMNode);
begin begin
ConvWrite(TDOMCharacterData(node).Data, TextSpecialChars, {$IFDEF FPC}@{$ENDIF}TextnodeSpecialCharCallback); ConvWrite(TDOMCharacterData(node).Data, TextSpecialChars, @TextnodeSpecialCharCallback);
end; end;
procedure TXMLWriter.VisitCDATA(node: TDOMNode); procedure TXMLWriter.VisitCDATA(node: TDOMNode);
begin begin
if not FInsideTextNode then if not FInsideTextNode then
wrtIndent; wrtIndent;
wrtChars('<![CDATA[', 9); if FCanonical then
wrtStr(TDOMCharacterData(node).Data); ConvWrite(TDOMCharacterData(node).Data, TextSpecialChars, @TextnodeSpecialCharCallback)
wrtChars(']]>', 3); else
begin
wrtChars('<![CDATA[', 9);
wrtStr(TDOMCharacterData(node).Data);
wrtChars(']]>', 3);
end;
end; end;
procedure TXMLWriter.VisitEntityRef(node: TDOMNode); procedure TXMLWriter.VisitEntityRef(node: TDOMNode);
@ -681,7 +688,7 @@ begin
ENTITY_REFERENCE_NODE: ENTITY_REFERENCE_NODE:
VisitEntityRef(Child); VisitEntityRef(Child);
TEXT_NODE: TEXT_NODE:
ConvWrite(TDOMCharacterData(Child).Data, AttrSpecialChars, {$IFDEF FPC}@{$ENDIF}AttrSpecialCharCallback); ConvWrite(TDOMCharacterData(Child).Data, AttrSpecialChars, @AttrSpecialCharCallback);
end; end;
Child := Child.NextSibling; Child := Child.NextSibling;
end; end;