paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-01 19:32:49 +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; FFilename: String;
{$IFDEF NewXMLCfg} {$IFDEF NewXMLCfg}
FReadFlags: TXMLReaderFlags; FReadFlags: TXMLReaderFlags;
FWriteFlags: TXMLWriterFlags;
{$ENDIF} {$ENDIF}
procedure SetFilename(const AFilename: String); procedure SetFilename(const AFilename: String);
protected protected
@ -112,6 +113,7 @@ type
property Document: TXMLDocument read doc; property Document: TXMLDocument read doc;
{$IFDEF NewXMLCfg} {$IFDEF NewXMLCfg}
property ReadFlags: TXMLReaderFlags read FReadFlags write FReadFlags; property ReadFlags: TXMLReaderFlags read FReadFlags write FReadFlags;
property WriteFlags: TXMLWriterFlags read FWriteFlags write FWriteFlags;
{$ENDIF} {$ENDIF}
end; end;
@ -141,7 +143,9 @@ constructor TXMLConfig.Create(const AFilename: String);
begin begin
//DebugLn(['TXMLConfig.Create ',AFilename]); //DebugLn(['TXMLConfig.Create ',AFilename]);
{$IFDEF NewXMLCfg} {$IFDEF NewXMLCfg}
// for compatibility with old TXMLConfig, which wrote #13 as #13, not as &xD;
FReadFlags:=[xrfAllowLowerThanInAttributeValue,xrfAllowSpecialCharsInAttributeValue]; FReadFlags:=[xrfAllowLowerThanInAttributeValue,xrfAllowSpecialCharsInAttributeValue];
FWriteFlags:=[xwfSpecialCharsInAttributeValue];
{$ENDIF} {$ENDIF}
inherited Create(nil); inherited Create(nil);
SetFilename(AFilename); SetFilename(AFilename);
@ -195,7 +199,12 @@ begin
if Modified and (Filename<>'') then if Modified and (Filename<>'') then
begin begin
//DebugLn(['TXMLConfig.Flush ',Filename]); //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; FModified := False;
end; end;
end; end;
@ -215,7 +224,7 @@ end;
procedure TXMLConfig.WriteToStream(s: TStream); procedure TXMLConfig.WriteToStream(s: TStream);
begin begin
{$IFDEF NewXMLCfg} {$IFDEF NewXMLCfg}
Laz2_XMLWrite.WriteXMLFile(Doc,s); Laz2_XMLWrite.WriteXMLFile(Doc,s,WriteFlags);
{$ELSE} {$ELSE}
Laz_XMLWrite.WriteXMLFile(Doc,s); Laz_XMLWrite.WriteXMLFile(Doc,s);
{$ENDIF} {$ENDIF}
@ -463,7 +472,7 @@ end;
procedure TXMLConfig.WriteXMLFile(ADoc: TXMLDocument; const AFileName: String); procedure TXMLConfig.WriteXMLFile(ADoc: TXMLDocument; const AFileName: String);
begin begin
{$IFDEF NewXMLCfg} {$IFDEF NewXMLCfg}
Laz2_XMLWrite.WriteXMLFile(ADoc,AFileName); Laz2_XMLWrite.WriteXMLFile(ADoc,AFileName,WriteFlags);
{$ELSE} {$ELSE}
Laz_XMLWrite.WriteXMLFile(ADoc,AFileName); Laz_XMLWrite.WriteXMLFile(ADoc,AFileName);
{$ENDIF} {$ENDIF}
@ -596,9 +605,13 @@ begin
end; end;
doc:=nil; 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 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 else if fAutoLoadFromSource<>'' then begin
ms:=TMemoryStream.Create; ms:=TMemoryStream.Create;
try try

16
components/codetools/laz2_xmlread.pas
View File

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

47
components/codetools/laz2_xmlwrite.pas
View File

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