paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-31 09:32:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

laz2_xml: compatibility with old xmlcfg

Browse Source 
git-svn-id: trunk@31610 -
This commit is contained in:
mattias 2011-07-09 08:07:57 +00:00
parent 6a55c3b32c
commit 8ce5534fb4
3 changed files with 64 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
components/codetools/laz2_xmlcfg.pas
View File

@ -55,6 +55,7 @@ type
FFilename: String;
{$IFDEF NewXMLCfg}
FReadFlags: TXMLReaderFlags;
FWriteFlags: TXMLWriterFlags;
{$ENDIF}
procedure SetFilename(const AFilename: String);
protected
@ -112,6 +113,7 @@ type
property Document: TXMLDocument read doc;
{$IFDEF NewXMLCfg}
property ReadFlags: TXMLReaderFlags read FReadFlags write FReadFlags;
property WriteFlags: TXMLWriterFlags read FWriteFlags write FWriteFlags;
{$ENDIF}
end;
@ -141,7 +143,9 @@ constructor TXMLConfig.Create(const AFilename: String);
begin
//DebugLn(['TXMLConfig.Create ',AFilename]);
{$IFDEF NewXMLCfg}
// for compatibility with old TXMLConfig, which wrote #13 as #13, not as &xD;
FReadFlags:=[xrfAllowLowerThanInAttributeValue,xrfAllowSpecialCharsInAttributeValue];
FWriteFlags:=[xwfSpecialCharsInAttributeValue];
{$ENDIF}
inherited Create(nil);
SetFilename(AFilename);
@ -195,7 +199,12 @@ begin
if Modified and (Filename<>'') then
begin
//DebugLn(['TXMLConfig.Flush ',Filename]);
WriteXMLFile(doc, Filename);
{$IFDEF NewXMLCfg}
Laz2_XMLWrite.WriteXMLFile(Doc,Filename,WriteFlags);
{$ELSE}
Laz_XMLWrite.WriteXMLFile(Doc,Filename);
{$ENDIF}
InvalidateFileStateCache;
FModified := False;
end;
end;
@ -215,7 +224,7 @@ end;
procedure TXMLConfig.WriteToStream(s: TStream);
begin
{$IFDEF NewXMLCfg}
Laz2_XMLWrite.WriteXMLFile(Doc,s);
Laz2_XMLWrite.WriteXMLFile(Doc,s,WriteFlags);
{$ELSE}
Laz_XMLWrite.WriteXMLFile(Doc,s);
{$ENDIF}
@ -463,7 +472,7 @@ end;
procedure TXMLConfig.WriteXMLFile(ADoc: TXMLDocument; const AFileName: String);
begin
{$IFDEF NewXMLCfg}
Laz2_XMLWrite.WriteXMLFile(ADoc,AFileName);
Laz2_XMLWrite.WriteXMLFile(ADoc,AFileName,WriteFlags);
{$ELSE}
Laz_XMLWrite.WriteXMLFile(ADoc,AFileName);
{$ENDIF}
@ -596,9 +605,13 @@ begin
end;
doc:=nil;
//debugln(['TXMLConfig.SetFilename ',not fDoNotLoadFromFile,' ',FileExistsCached(Filename)]);
//debugln(['TXMLConfig.SetFilename Load=',not fDoNotLoadFromFile,' FileExists=',FileExistsCached(Filename),' File=',Filename]);
if (not fDoNotLoadFromFile) and FileExistsCached(Filename) then
ReadXMLFile(doc,Filename)
{$IFDEF NewXMLCfg}
Laz2_XMLRead.ReadXMLFile(doc,Filename,ReadFlags)
{$ELSE}
Laz_XMLRead.ReadXMLFile(doc,Filename)
{$ENDIF}
else if fAutoLoadFromSource<>'' then begin
ms:=TMemoryStream.Create;
try

16
components/codetools/laz2_xmlread.pas
View File

@ -1831,7 +1831,7 @@ begin
case Value of
$01..$08, $0B..$0C, $0E..$1F:
if FXML11 then
if FXML11 or (xrfAllowSpecialCharsInAttributeValue in FFlags) then
BufAppend(ToFill, DOMChar(Value))
else
FatalError('Invalid character reference');
@ -1875,7 +1875,10 @@ begin
end;
const
AttrDelims: TSetOfChar = [#0, '<', '&', '''', '"', #9, #10, #13];
AttrDelims: array[boolean] of TSetOfChar = (
[#0, '<', '&', '''', '"', #9, #10, #13], // false: default
[#0, '<', '&', '''', '"'] // true: xrfAllowSpecialCharsInAttributeValue
);
GT_Delim: TSetOfChar = [#0, '>'];
procedure TXMLReader.ExpectAttValue;
@ -1884,12 +1887,14 @@ var
Delim: DOMChar;
ent: TDOMEntityEx;
start: TObject;
AllowSpecialChars: boolean;
begin
SkipQuote(Delim);
FValue.Length := 0;
start := FSource.FEntity;
AllowSpecialChars:=xrfAllowSpecialCharsInAttributeValue in Flags;
repeat
wc := FSource.SkipUntil(FValue, AttrDelims, nil, xrfAllowSpecialCharsInAttributeValue in Flags);
wc := FSource.SkipUntil(FValue, AttrDelims[AllowSpecialChars], nil, AllowSpecialChars);
if (wc = '<') and (not (xrfAllowLowerThanInAttributeValue in Flags)) then
FatalError('Character ''<'' is not allowed in attribute value')
else if wc = '&' then
@ -3040,8 +3045,9 @@ begin
repeat
wc := FBuf^;
//writeln('TXMLDecodingSource.SkipUntil ',ord(wc));
if (wc = #10) or (wc = #13)
or (FXML11Rules and ((wc = #$85) or (wc = #$2028))) // ToDo #$2028
if (not AllowSpecialChars)
and ((wc = #10) or (wc = #13)
or (FXML11Rules and ((wc = #$85) or (wc = #$2028)))) // ToDo #$2028
then begin
// strictly this is needed only for 2-byte lineendings
BufAppendChunk(ToFill, old, FBuf);

47
components/codetools/laz2_xmlwrite.pas
View File

@ -29,9 +29,15 @@ interface
uses Classes, laz2_DOM, SysUtils, laz2_xmlutils;
procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String); overload;
procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text); overload;
procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream); overload;
type
TXMLWriterFlag = (
xwfSpecialCharsInAttributeValue // write #13 as #13 instead of as &xD;
);
TXMLWriterFlags = set of TXMLWriterFlag;
procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String; Flags: TXMLWriterFlags = []); overload;
procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text; Flags: TXMLWriterFlags = []); overload;
procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream; Flags: TXMLWriterFlags = []); overload;
procedure WriteXML(Element: TDOMNode; const AFileName: String); overload;
procedure WriteXML(Element: TDOMNode; var AFile: Text); overload;
@ -53,6 +59,8 @@ type
Prefix: PHashItem;
end;
{ TXMLWriter }
TXMLWriter = class(TObject)
private
FInsideTextNode: Boolean;
@ -67,6 +75,7 @@ type
FAttrFixups: TFPList;
FScratch: TFPList;
FNSDefs: TFPList;
FWriteFlags: TXMLWriterFlags;
procedure wrtChars(Src: DOMPChar; Length: Integer);
procedure IncIndent;
procedure DecIndent; {$IFDEF HAS_INLINE} inline; {$ENDIF}
@ -95,6 +104,7 @@ type
public
constructor Create;
destructor Destroy; override;
property WriteFlags: TXMLWriterFlags read FWriteFlags write FWriteFlags;
end;
TTextXMLWriter = Class(TXMLWriter)
@ -160,7 +170,10 @@ end;
---------------------------------------------------------------------}
const
AttrSpecialChars = ['<', '"', '&', #0..#31];
AttrSpecialChars : array[boolean] of TSetOfChar = (
['<', '"', '&', #0..#31], // false: default
['<', '"', '&'] // true: write special characters
);
TextSpecialChars = ['<', '>', '&', #0..#31];
CDSectSpecialChars = [']'];
LineEndingChars = [#13, #10];
@ -457,7 +470,8 @@ begin
wrtStr(B.Prefix^.Key);
end;
wrtChars('="', 2);
ConvWrite(B.uri, AttrSpecialChars, @AttrSpecialCharCallback);
ConvWrite(B.uri, AttrSpecialChars[xwfSpecialCharsInAttributeValue in FWriteFlags],
@AttrSpecialCharCallback);
wrtChr('"');
end;
@ -591,7 +605,9 @@ begin
wrtChars('="', 2);
// TODO: not correct w.r.t. entities
ConvWrite(attr.nodeValue, AttrSpecialChars, @AttrSpecialCharCallback);
ConvWrite(attr.nodeValue,
AttrSpecialChars[xwfSpecialCharsInAttributeValue in FWriteFlags],
@AttrSpecialCharCallback);
wrtChr('"');
end;
end;
@ -775,12 +791,14 @@ begin
Child := Node.FirstChild;
while Assigned(Child) do
begin
writeln('TXMLWriter.VisitAttribute ',Child.NodeType);
//writeln('TXMLWriter.VisitAttribute ',Child.NodeType);
case Child.NodeType of
ENTITY_REFERENCE_NODE:
VisitEntityRef(Child);
TEXT_NODE:
ConvWrite(TDOMCharacterData(Child).Data, AttrSpecialChars, @AttrSpecialCharCallback);
ConvWrite(TDOMCharacterData(Child).Data,
AttrSpecialChars[xwfSpecialCharsInAttributeValue in FWriteFlags],
@AttrSpecialCharCallback);
end;
Child := Child.NextSibling;
end;
@ -836,32 +854,37 @@ end;
// Interface implementation
// -------------------------------------------------------------------
procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String);
procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String;
Flags: TXMLWriterFlags = []);
var
fs: TFileStream;
begin
fs := TFileStream.Create(AFileName, fmCreate);
try
WriteXMLFile(doc, fs);
WriteXMLFile(doc, fs, Flags);
finally
fs.Free;
end;
end;
procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text;
Flags: TXMLWriterFlags = []);
begin
with TTextXMLWriter.Create(AFile) do
try
WriteFlags:=Flags;
WriteNode(doc);
finally
Free;
end;
end;
procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream);
procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream;
Flags: TXMLWriterFlags = []);
begin
with TStreamXMLWriter.Create(AStream) do
try
WriteFlags:=Flags;
WriteNode(doc);
finally
Free;