paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-31 08:21:39 +01:00
Code Issues Packages Projects Releases Wiki Activity

MG: removed the 1x1 bitmap from TBitBtn

Browse Source 
git-svn-id: trunk@2773 -
This commit is contained in:
lazarus 2002-08-18 08:53:53 +00:00
parent 00fe5ced56
commit a01c08ffab
7 changed files with 301 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
components/codetools/avl_tree.pas
View File

@ -31,7 +31,11 @@ unit AVL_Tree;
interface interface
uses Classes, SysUtils; {off $DEFINE MEM_CHECK}
uses
{$IFDEF MEM_CHECK}MemCheck,{$ENDIF}
Classes, SysUtils;
type type
TAVLTreeNode = class TAVLTreeNode = class

4
components/codetools/codetools.inc
View File

@ -25,8 +25,8 @@
} }
{ $DEFINE MEM_CHECK} {off $DEFINE MEM_CHECK}
{ $DEFINE CTDEBUG} {off $DEFINE CTDEBUG}
// end. // end.

15
components/codetools/laz_xmlcfg.pas
View File

@ -32,7 +32,11 @@ unit Laz_XMLCfg;
interface interface
uses Classes, Laz_DOM, Laz_XMLRead, Laz_XMLWrite; {off $DEFINE MEM_CHECK}
uses
{$IFDEF MEM_CHECK}MemCheck,{$ENDIF}
Classes, Laz_DOM, Laz_XMLRead, Laz_XMLWrite;
type type
@ -74,6 +78,7 @@ uses SysUtils;
constructor TXMLConfig.Create(const AFilename: String); constructor TXMLConfig.Create(const AFilename: String);
begin begin
//writeln('TXMLConfig.Create ',AFilename);
inherited Create(nil); inherited Create(nil);
SetFilename(AFilename); SetFilename(AFilename);
end; end;
@ -207,6 +212,8 @@ var
f: File; f: File;
cfg: TDOMElement; cfg: TDOMElement;
begin begin
{$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLConfig.SetFilename A '+AFilename);{$ENDIF}
if FFilename = AFilename then exit;
FFilename := AFilename; FFilename := AFilename;
if csLoading in ComponentState then if csLoading in ComponentState then
@ -224,7 +231,9 @@ begin
{$I+} {$I+}
if IOResult = 0 then if IOResult = 0 then
try try
{$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLConfig.SetFilename B');{$ENDIF}
ReadXMLFile(doc, f); ReadXMLFile(doc, f);
{$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLConfig.SetFilename C');{$ENDIF}
finally finally
CloseFile(f); CloseFile(f);
end; end;
@ -237,12 +246,16 @@ begin
cfg := doc.CreateElement('CONFIG'); cfg := doc.CreateElement('CONFIG');
doc.AppendChild(cfg); doc.AppendChild(cfg);
end; end;
{$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLConfig.SetFilename END');{$ENDIF}
end; end;
end. end.
{ {
$Log$ $Log$
Revision 1.3 2002/09/13 16:58:27 lazarus
MG: removed the 1x1 bitmap from TBitBtn
Revision 1.2 2002/07/30 14:36:28 lazarus Revision 1.2 2002/07/30 14:36:28 lazarus
MG: accelerated xmlread and xmlwrite MG: accelerated xmlread and xmlwrite

342
components/codetools/laz_xmlread.pas
View File

@ -20,14 +20,18 @@
**********************************************************************} **********************************************************************}
unit Laz_XMLRead;
{$MODE objfpc} {$MODE objfpc}
{$H+} {$H+}
unit Laz_XMLRead;
interface interface
uses SysUtils, Classes, Laz_DOM; {off $DEFINE MEM_CHECK}
uses
{$IFDEF MEM_CHECK}MemCheck,{$ENDIF}
SysUtils, Classes, Laz_DOM;
type type
@ -62,8 +66,63 @@ const
NmToken: set of Char = Letter + Digit + ['.', '-', '_', ':']; NmToken: set of Char = Letter + Digit + ['.', '-', '_', ':'];
type function CompareIPChar(p1, p2: PChar): boolean;
begin
if p1<>p2 then begin
if (p1<>nil) and (p2<>nil) then begin
while true do begin
if (p1^=p2^) then begin
if p1^<>#0 then begin
inc(p1);
inc(p2);
end else begin
Result:=true;
exit;
end;
end else begin
Result:=false;
exit;
end;
end;
Result:=true;
end else begin
Result:=false;
end;
end else begin
Result:=true;
end;
end;
function CompareLIPChar(p1, p2: PChar; Max: integer): boolean;
begin
if p1<>p2 then begin
if (p1<>nil) and (p2<>nil) then begin
while Max>0 do begin
if (p1^=p2^) then begin
if (p1^<>#0) then begin
inc(p1);
inc(p2);
dec(Max);
end else begin
Result:=true;
exit;
end;
end else begin
Result:=false;
exit;
end;
end;
Result:=true;
end else begin
Result:=false;
end;
end else begin
Result:=true;
end;
end;
type
TXMLReaderDocument = class(TXMLDocument) TXMLReaderDocument = class(TXMLDocument)
public public
procedure SetDocType(ADocType: TDOMDocumentType); procedure SetDocType(ADocType: TDOMDocumentType);
@ -83,19 +142,22 @@ type
buf, BufStart: PChar; buf, BufStart: PChar;
Filename: String; Filename: String;
procedure RaiseExc(descr: String); procedure RaiseExc(const descr: String);
function SkipWhitespace: Boolean; function SkipWhitespace: Boolean;
procedure ExpectWhitespace; procedure ExpectWhitespace;
procedure ExpectString(s: String); procedure ExpectString(const s: String);
function CheckFor(s: PChar): Boolean; function CheckFor(s: PChar): Boolean;
procedure SkipString(ValidChars: TSetOfChar); procedure SkipString(const ValidChars: TSetOfChar);
function GetString(ValidChars: TSetOfChar): String; function GetString(const ValidChars: TSetOfChar): String;
function GetString(BufPos: PChar; Len: integer): String; function GetString(BufPos: PChar; Len: integer): String;
function CheckName: Boolean;
function GetName(var s: String): Boolean; function GetName(var s: String): Boolean;
function ExpectName: String; // [5] function ExpectName: String; // [5]
procedure SkipName;
procedure ExpectAttValue(attr: TDOMAttr); // [10] procedure ExpectAttValue(attr: TDOMAttr); // [10]
function ExpectPubidLiteral: String; // [12] function ExpectPubidLiteral: String; // [12]
procedure SkipPubidLiteral;
function ParseComment(AOwner: TDOMNode): Boolean; // [15] function ParseComment(AOwner: TDOMNode): Boolean; // [15]
function ParsePI: Boolean; // [16] function ParsePI: Boolean; // [16]
procedure ExpectProlog; // [22] procedure ExpectProlog; // [22]
@ -111,15 +173,16 @@ type
function ParseExternalID: Boolean; // [75] function ParseExternalID: Boolean; // [75]
procedure ExpectExternalID; procedure ExpectExternalID;
function ParseEncodingDecl: String; // [80] function ParseEncodingDecl: String; // [80]
procedure SkipEncodingDecl;
procedure ResolveEntities(RootNode: TDOMNode); procedure ResolveEntities(RootNode: TDOMNode);
public public
doc: TXMLReaderDocument; doc: TXMLReaderDocument;
procedure ProcessXML(ABuf: PChar; AFilename: String); // [1] procedure ProcessXML(ABuf: PChar; const AFilename: String); // [1]
procedure ProcessDTD(ABuf: PChar; AFilename: String); // ([29]) procedure ProcessDTD(ABuf: PChar; const AFilename: String); // ([29])
end; end;
{ TXMLReaderDocument }
procedure TXMLReaderDocument.SetDocType(ADocType: TDOMDocumentType); procedure TXMLReaderDocument.SetDocType(ADocType: TDOMDocumentType);
begin begin
@ -134,7 +197,7 @@ end;
procedure TXMLReader.RaiseExc(descr: String); procedure TXMLReader.RaiseExc(const descr: String);
var var
apos: PChar; apos: PChar;
x, y: Integer; x, y: Integer;
@ -172,20 +235,27 @@ begin
RaiseExc('Expected whitespace'); RaiseExc('Expected whitespace');
end; end;
procedure TXMLReader.ExpectString(s: String); procedure TXMLReader.ExpectString(const s: String);
var
i: Integer; procedure RaiseStringNotFound;
var
s2: PChar; s2: PChar;
s3: String; s3: String;
begin begin
for i := 1 to Length(s) do
if buf[i - 1] <> s[i] then begin
GetMem(s2, Length(s) + 1); GetMem(s2, Length(s) + 1);
StrLCopy(s2, buf, Length(s)); StrLCopy(s2, buf, Length(s));
s3 := StrPas(s2); s3 := StrPas(s2);
FreeMem(s2, Length(s) + 1); FreeMem(s2, Length(s) + 1);
RaiseExc('Expected "' + s + '", found "' + s3 + '"'); RaiseExc('Expected "' + s + '", found "' + s3 + '"');
end; end;
var
i: Integer;
begin
for i := 1 to Length(s) do
if buf[i - 1] <> s[i] then begin
RaiseStringNotFound;
end;
Inc(buf, Length(s)); Inc(buf, Length(s));
end; end;
@ -202,14 +272,14 @@ begin
Result := False; Result := False;
end; end;
procedure TXMLReader.SkipString(ValidChars: TSetOfChar); procedure TXMLReader.SkipString(const ValidChars: TSetOfChar);
begin begin
while buf[0] in ValidChars do begin while buf[0] in ValidChars do begin
Inc(buf); Inc(buf);
end; end;
end; end;
function TXMLReader.GetString(ValidChars: TSetOfChar): String; function TXMLReader.GetString(const ValidChars: TSetOfChar): String;
var var
OldBuf: PChar; OldBuf: PChar;
i, len: integer; i, len: integer;
@ -236,7 +306,7 @@ begin
end; end;
end; end;
procedure TXMLReader.ProcessXML(ABuf: PChar; AFilename: String); // [1] procedure TXMLReader.ProcessXML(ABuf: PChar; const AFilename: String); // [1]
//var //var
// LastNodeBeforeDoc: TDOMNode; // LastNodeBeforeDoc: TDOMNode;
begin begin
@ -246,8 +316,10 @@ begin
doc := TXMLReaderDocument.Create; doc := TXMLReaderDocument.Create;
ExpectProlog; ExpectProlog;
{$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLReader.ProcessXML A');{$ENDIF}
//LastNodeBeforeDoc := doc.LastChild; //LastNodeBeforeDoc := doc.LastChild;
ExpectElement(doc); ExpectElement(doc);
{$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLReader.ProcessXML B');{$ENDIF}
ParseMisc(doc); ParseMisc(doc);
if buf[0] <> #0 then if buf[0] <> #0 then
@ -262,6 +334,20 @@ begin
} }
end; end;
function TXMLReader.CheckName: Boolean;
var OldBuf: PChar;
begin
if not (buf[0] in (Letter + ['_', ':'])) then begin
Result := False;
exit;
end;
OldBuf := buf;
Inc(buf);
SkipString(Letter + ['0'..'9', '.', '-', '_', ':']);
buf := OldBuf;
Result := True;
end;
function TXMLReader.GetName(var s: String): Boolean; // [5] function TXMLReader.GetName(var s: String): Boolean; // [5]
var OldBuf: PChar; var OldBuf: PChar;
@ -280,10 +366,16 @@ begin
end; end;
function TXMLReader.ExpectName: String; // [5] function TXMLReader.ExpectName: String; // [5]
procedure RaiseNameNotFound;
begin
RaiseExc('Expected letter, "_" or ":" for name, found "' + buf[0] + '"');
end;
var OldBuf: PChar; var OldBuf: PChar;
begin begin
if not (buf[0] in (Letter + ['_', ':'])) then if not (buf[0] in (Letter + ['_', ':'])) then
RaiseExc('Expected letter, "_" or ":" for name, found "' + buf[0] + '"'); RaiseNameNotFound;
OldBuf := buf; OldBuf := buf;
Inc(buf); Inc(buf);
@ -291,19 +383,32 @@ begin
Result:=GetString(OldBuf,buf-OldBuf); Result:=GetString(OldBuf,buf-OldBuf);
end; end;
procedure TXMLReader.SkipName;
procedure RaiseSkipNameNotFound;
begin
RaiseExc('Expected letter, "_" or ":" for name, found "' + buf[0] + '"');
end;
begin
if not (buf[0] in (Letter + ['_', ':'])) then
RaiseSkipNameNotFound;
Inc(buf);
SkipString(Letter + ['0'..'9', '.', '-', '_', ':']);
end;
procedure TXMLReader.ExpectAttValue(attr: TDOMAttr); // [10] procedure TXMLReader.ExpectAttValue(attr: TDOMAttr); // [10]
var var
s: String;
OldBuf: PChar; OldBuf: PChar;
procedure FlushStringBuffer; procedure FlushStringBuffer;
var
s: String;
begin begin
if OldBuf<>buf then begin if OldBuf<>buf then begin
s := s + GetString(OldBuf,buf-OldBuf); s := GetString(OldBuf,buf-OldBuf);
OldBuf := buf; OldBuf := buf;
end;
if Length(s) > 0 then
begin
attr.AppendChild(doc.CreateTextNode(s)); attr.AppendChild(doc.CreateTextNode(s));
SetLength(s, 0); SetLength(s, 0);
end; end;
@ -317,12 +422,11 @@ begin
StrDel[0] := buf[0]; StrDel[0] := buf[0];
StrDel[1] := #0; StrDel[1] := #0;
Inc(buf); Inc(buf);
SetLength(s, 0);
OldBuf := buf; OldBuf := buf;
while not CheckFor(StrDel) do while not CheckFor(StrDel) do
if buf[0] = '&' then if buf[0] = '&' then
begin begin
FlushStringBuffer; if OldBuf<>buf then FlushStringBuffer;
ParseReference(attr); ParseReference(attr);
OldBuf := buf; OldBuf := buf;
end else end else
@ -330,7 +434,7 @@ begin
Inc(buf); Inc(buf);
end; end;
dec(buf); dec(buf);
FlushStringBuffer; if OldBuf<>buf then FlushStringBuffer;
inc(buf); inc(buf);
ResolveEntities(Attr); ResolveEntities(Attr);
end; end;
@ -348,13 +452,24 @@ begin
RaiseExc('Expected quotation marks'); RaiseExc('Expected quotation marks');
end; end;
procedure TXMLReader.SkipPubidLiteral;
begin
if CheckFor('''') then begin
SkipString(PubidChars - ['''']);
ExpectString('''');
end else if CheckFor('"') then begin
SkipString(PubidChars - ['"']);
ExpectString('"');
end else
RaiseExc('Expected quotation marks');
end;
function TXMLReader.ParseComment(AOwner: TDOMNode): Boolean; // [15] function TXMLReader.ParseComment(AOwner: TDOMNode): Boolean; // [15]
var var
comment: String; comment: String;
OldBuf: PChar; OldBuf: PChar;
begin begin
if CheckFor('<!--') then begin if CheckFor('<!--') then begin
SetLength(comment, 0);
OldBuf := buf; OldBuf := buf;
while (buf[0] <> #0) and (buf[1] <> #0) and while (buf[0] <> #0) and (buf[1] <> #0) and
((buf[0] <> '-') or (buf[1] <> '-')) do begin ((buf[0] <> '-') or (buf[1] <> '-')) do begin
@ -369,14 +484,11 @@ begin
end; end;
function TXMLReader.ParsePI: Boolean; // [16] function TXMLReader.ParsePI: Boolean; // [16]
var
checkbuf: array[0..3] of char;
begin begin
if CheckFor('<?') then begin if CheckFor('<?') then begin
StrLCopy(checkbuf, buf, 3); if CompareLIPChar(buf,'XML',3) then
if UpCase(StrPas(checkbuf)) = 'XML' then
RaiseExc('"<?xml" processing instruction not allowed here'); RaiseExc('"<?xml" processing instruction not allowed here');
ExpectName; SkipName;
if SkipWhitespace then if SkipWhitespace then
while (buf[0] <> #0) and (buf[1] <> #0) and not while (buf[0] <> #0) and (buf[1] <> #0) and not
((buf[0] = '?') and (buf[1] = '>')) do Inc(buf); ((buf[0] = '?') and (buf[1] = '>')) do Inc(buf);
@ -429,7 +541,7 @@ begin
RaiseExc('Expected single or double quotation mark'); RaiseExc('Expected single or double quotation mark');
// EncodingDecl? // EncodingDecl?
ParseEncodingDecl; SkipEncodingDecl;
// SDDecl? // SDDecl?
SkipWhitespace; SkipWhitespace;
@ -528,7 +640,7 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
if CheckFor('(') then if CheckFor('(') then
ExpectChoiceOrSeq ExpectChoiceOrSeq
else else
ExpectName; SkipName;
if CheckFor('?') then if CheckFor('?') then
else if CheckFor('*') then else if CheckFor('*') then
else if CheckFor('+') then; else if CheckFor('+') then;
@ -558,7 +670,7 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
begin begin
if CheckFor('<!ELEMENT') then begin if CheckFor('<!ELEMENT') then begin
ExpectWhitespace; ExpectWhitespace;
ExpectName; SkipName;
ExpectWhitespace; ExpectWhitespace;
// Get contentspec [46] // Get contentspec [46]
@ -574,7 +686,7 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
repeat repeat
ExpectString('|'); ExpectString('|');
SkipWhitespace; SkipWhitespace;
ExpectName; SkipName;
until CheckFor(')*'); until CheckFor(')*');
end else begin end else begin
// Parse Children section [47] // Parse Children section [47]
@ -601,10 +713,10 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
begin begin
if CheckFor('<!ATTLIST') then begin if CheckFor('<!ATTLIST') then begin
ExpectWhitespace; ExpectWhitespace;
ExpectName; SkipName;
SkipWhitespace; SkipWhitespace;
while not CheckFor('>') do begin while not CheckFor('>') do begin
ExpectName; SkipName;
ExpectWhitespace; ExpectWhitespace;
// Get AttType [54], [55], [56] // Get AttType [54], [55], [56]
@ -620,12 +732,12 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
ExpectWhitespace; ExpectWhitespace;
ExpectString('('); ExpectString('(');
SkipWhitespace; SkipWhitespace;
ExpectName; SkipName;
SkipWhitespace; SkipWhitespace;
while not CheckFor(')') do begin while not CheckFor(')') do begin
ExpectString('|'); ExpectString('|');
SkipWhitespace; SkipWhitespace;
ExpectName; SkipName;
SkipWhitespace; SkipWhitespace;
end; end;
end else if CheckFor('(') then begin // [59] end else if CheckFor('(') then begin // [59]
@ -707,7 +819,7 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
ExpectWhitespace; ExpectWhitespace;
ExpectString('NDATA'); ExpectString('NDATA');
ExpectWhitespace; ExpectWhitespace;
ExpectName; SkipName;
end; end;
end; end;
SkipWhitespace; SkipWhitespace;
@ -721,12 +833,12 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
begin begin
if CheckFor('<!NOTATION') then begin if CheckFor('<!NOTATION') then begin
ExpectWhitespace; ExpectWhitespace;
ExpectName; SkipName;
ExpectWhitespace; ExpectWhitespace;
if ParseExternalID then if ParseExternalID then
else if CheckFor('PUBLIC') then begin // [83] else if CheckFor('PUBLIC') then begin // [83]
ExpectWhitespace; ExpectWhitespace;
ExpectPubidLiteral; SkipPubidLiteral;
end else end else
RaiseExc('Expected external or public ID'); RaiseExc('Expected external or public ID');
SkipWhitespace; SkipWhitespace;
@ -743,7 +855,7 @@ begin
Result := True; Result := True;
end; end;
procedure TXMLReader.ProcessDTD(ABuf: PChar; AFilename: String); procedure TXMLReader.ProcessDTD(ABuf: PChar; const AFilename: String);
begin begin
buf := ABuf; buf := ABuf;
BufStart := ABuf; BufStart := ABuf;
@ -765,71 +877,68 @@ function TXMLReader.ParseElement(AOwner: TDOMNode): Boolean; // [39] [40] [44
var var
NewElem: TDOMElement; NewElem: TDOMElement;
procedure CreateTextNode(BufStart: PChar; BufLen: integer);
// Note: this proc exists, to reduce creating temporary strings
begin
NewElem.AppendChild(doc.CreateTextNode(GetString(BufStart,BufLen)));
end;
function ParseCharData: Boolean; // [14] function ParseCharData: Boolean; // [14]
var var
s: String; p: PChar;
i: Integer; DataLen: integer;
OldBuf: PChar; OldBuf: PChar;
begin begin
SetLength(s, 0);
OldBuf := buf; OldBuf := buf;
while not (buf[0] in [#0, '<', '&']) do while not (buf[0] in [#0, '<', '&']) do
begin begin
Inc(buf); Inc(buf);
end; end;
s:=GetString(OldBuf,buf-OldBuf); DataLen:=buf-OldBuf;
if Length(s) > 0 then if DataLen > 0 then
begin begin
// Check if s has non-whitespace content // Check if chardata has non-whitespace content
i := Length(s); p:=OldBuf;
while (i > 0) and (s[i] in WhitespaceChars) do while (p<buf) and (p[0] in WhitespaceChars) do
Dec(i); inc(p);
if i > 0 then if p=buf then
NewElem.AppendChild(doc.CreateTextNode(s)); CreateTextNode(OldBuf,DataLen);
Result := True; Result := True;
end else end else
Result := False; Result := False;
end; end;
procedure CreateCDATASectionChild(BufStart: PChar; BufLen: integer);
// Note: this proc exists, to reduce creating temporary strings
begin
NewElem.AppendChild(doc.CreateCDATASection(GetString(BufStart,BufLen)));
end;
function ParseCDSect: Boolean; // [18] function ParseCDSect: Boolean; // [18]
var var
cdata: String;
OldBuf: PChar; OldBuf: PChar;
begin begin
if CheckFor('<![CDATA[') then if CheckFor('<![CDATA[') then
begin begin
SetLength(cdata, 0);
OldBuf := buf; OldBuf := buf;
while not CheckFor(']]>') do while not CheckFor(']]>') do
begin begin
Inc(buf); Inc(buf);
end; end;
cdata := GetString(OldBuf,buf-OldBuf); CreateCDATASectionChild(OldBuf,buf-OldBuf);
NewElem.AppendChild(doc.CreateCDATASection(cdata));
Result := True; Result := True;
end else end else
Result := False; Result := False;
end; end;
procedure CreateNameElement;
var
var
IsEmpty: Boolean; IsEmpty: Boolean;
name: String;
oldpos: PChar;
attr: TDOMAttr; attr: TDOMAttr;
begin name: string;
oldpos := buf;
if CheckFor('<') then
begin begin
if not GetName(name) then {$IFDEF MEM_CHECK}CheckHeapWrtMemCnt(' CreateNameElement A');{$ENDIF}
begin GetName(name);
buf := oldpos;
Result := False;
exit;
end;
NewElem := doc.CreateElement(name); NewElem := doc.CreateElement(name);
AOwner.AppendChild(NewElem); AOwner.AppendChild(NewElem);
@ -837,6 +946,7 @@ begin
IsEmpty := False; IsEmpty := False;
while True do while True do
begin begin
{$IFDEF MEM_CHECK}CheckHeapWrtMemCnt(' CreateNameElement E');{$ENDIF}
if CheckFor('/>') then if CheckFor('/>') then
begin begin
IsEmpty := True; IsEmpty := True;
@ -870,13 +980,28 @@ begin
ExpectString('>'); ExpectString('>');
end; end;
{$IFDEF MEM_CHECK}CheckHeapWrtMemCnt(' CreateNameElement END');{$ENDIF}
ResolveEntities(NewElem); ResolveEntities(NewElem);
end;
var
OldBuf: PChar;
begin
OldBuf := Buf;
if CheckFor('<') then
begin
{$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLReader.ParseElement A');{$ENDIF}
if not CheckName then
begin
Buf := OldBuf;
Result := False;
end else begin
CreateNameElement;
Result := True; Result := True;
end;
end else end else
Result := False; Result := False;
{$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLReader.ParseElement END');{$ENDIF}
end; end;
procedure TXMLReader.ExpectElement(AOwner: TDOMNode); procedure TXMLReader.ExpectElement(AOwner: TDOMNode);
@ -888,7 +1013,7 @@ end;
function TXMLReader.ParsePEReference: Boolean; // [69] function TXMLReader.ParsePEReference: Boolean; // [69]
begin begin
if CheckFor('%') then begin if CheckFor('%') then begin
ExpectName; SkipName;
ExpectString(';'); ExpectString(';');
Result := True; Result := True;
end else end else
@ -947,16 +1072,33 @@ function TXMLReader.ParseExternalID: Boolean; // [75]
end; end;
end; end;
procedure SkipSystemLiteral;
begin
if buf[0] = '''' then begin
Inc(buf);
while (buf[0] <> '''') and (buf[0] <> #0) do begin
Inc(buf);
end;
ExpectString('''');
end else if buf[0] = '"' then begin
Inc(buf);
while (buf[0] <> '"') and (buf[0] <> #0) do begin
Inc(buf);
end;
ExpectString('"');
end;
end;
begin begin
if CheckFor('SYSTEM') then begin if CheckFor('SYSTEM') then begin
ExpectWhitespace; ExpectWhitespace;
GetSystemLiteral; SkipSystemLiteral;
Result := True; Result := True;
end else if CheckFor('PUBLIC') then begin end else if CheckFor('PUBLIC') then begin
ExpectWhitespace; ExpectWhitespace;
ExpectPubidLiteral; SkipPubidLiteral;
ExpectWhitespace; ExpectWhitespace;
GetSystemLiteral; SkipSystemLiteral;
Result := True; Result := True;
end else end else
Result := False; Result := False;
@ -998,6 +1140,32 @@ begin
end; end;
end; end;
procedure TXMLReader.SkipEncodingDecl;
procedure ParseEncName;
begin
if not (buf[0] in ['A'..'Z', 'a'..'z']) then
RaiseExc('Expected character (A-Z, a-z)');
Inc(buf);
SkipString(['A'..'Z', 'a'..'z', '0'..'9', '.', '_', '-']);
end;
begin
SkipWhitespace;
if CheckFor('encoding') then begin
ExpectEq;
if buf[0] = '''' then begin
Inc(buf);
ParseEncName;
ExpectString('''');
end else if buf[0] = '"' then begin
Inc(buf);
ParseEncName;
ExpectString('"');
end;
end;
end;
{ Currently, this method will only resolve the entities which are { Currently, this method will only resolve the entities which are
predefined in XML: } predefined in XML: }
@ -1085,6 +1253,7 @@ begin
GetMem(buf, f.Size + 1); GetMem(buf, f.Size + 1);
f.Read(buf^, f.Size); f.Read(buf^, f.Size);
buf[f.Size] := #0; buf[f.Size] := #0;
reader := TXMLReader.Create; reader := TXMLReader.Create;
reader.ProcessXML(buf, AFilename); reader.ProcessXML(buf, AFilename);
FreeMem(buf, f.Size + 1); FreeMem(buf, f.Size + 1);
@ -1174,6 +1343,9 @@ end.
{ {
$Log$ $Log$
Revision 1.4 2002/09/13 16:58:27 lazarus
MG: removed the 1x1 bitmap from TBitBtn
Revision 1.3 2002/08/04 07:44:44 lazarus Revision 1.3 2002/08/04 07:44:44 lazarus
MG: fixed xml reading writing of special chars MG: fixed xml reading writing of special chars

7
ide/main.pp
View File

@ -4374,8 +4374,12 @@ begin
Project1:=TProject.Create(ptProgram); Project1:=TProject.Create(ptProgram);
Project1.OnFileBackup:=@DoBackupFile; Project1.OnFileBackup:=@DoBackupFile;
// read project info file // read project info file
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TMainIDE.DoOpenProjectFile B3');{$ENDIF}
Project1.ReadProject(AFilename); Project1.ReadProject(AFilename);
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TMainIDE.DoOpenProjectFile B4');{$ENDIF}
Result:=DoCompleteLoadingProjectInfo; Result:=DoCompleteLoadingProjectInfo;
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TMainIDE.DoOpenProjectFile B5');{$ENDIF}
if Result<>mrOk then exit; if Result<>mrOk then exit;
if Project1.MainUnit>=0 then begin if Project1.MainUnit>=0 then begin
@ -7056,6 +7060,9 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.378 2002/09/13 16:58:23 lazarus
MG: removed the 1x1 bitmap from TBitBtn
Revision 1.377 2002/09/13 07:01:17 lazarus Revision 1.377 2002/09/13 07:01:17 lazarus
MG: fixed memcheck MG: fixed memcheck

7
lcl/include/bitmapcanvas.inc
View File

@ -1,3 +1,5 @@
// included by graphics.pp
{****************************************************************************** {******************************************************************************
TBITMAPCANVAS TBITMAPCANVAS
****************************************************************************** ******************************************************************************
@ -105,9 +107,14 @@ begin
end; end;
end; end;
// included by graphics.pp
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.6 2002/09/13 16:58:27 lazarus
MG: removed the 1x1 bitmap from TBitBtn
Revision 1.5 2002/06/01 08:41:28 lazarus Revision 1.5 2002/06/01 08:41:28 lazarus
MG: DrawFramControl now uses gtk style, transparent STrechBlt MG: DrawFramControl now uses gtk style, transparent STrechBlt

4
lcl/include/statuspanels.inc
View File

@ -1,3 +1,5 @@
// included by comctrls.pp
{ TStatusPanels { TStatusPanels
***************************************************************************** *****************************************************************************
@ -46,3 +48,5 @@ begin
FStatusBar.Invalidate; FStatusBar.Invalidate;
end; end;
// included by comctrls.pp