From 4a9da60a1dd1d301f9583337a1b769ccda17a0d9 Mon Sep 17 00:00:00 2001 From: wp_xyz Date: Fri, 27 May 2022 12:25:20 +0200 Subject: [PATCH] Turbopower_ipro: Refactor unit ipHtml by extracting parser into separate unit. --- components/turbopower_ipro/ipcss.pas | 836 +++++ components/turbopower_ipro/iphtml.pas | 585 ++-- .../turbopower_ipro/iphtmlblocklayout.pas | 2 +- components/turbopower_ipro/iphtmlparser.pas | 3060 +++++++++++++++++ components/turbopower_ipro/iphtmlprop.pas | 2 +- components/turbopower_ipro/iphtmlutils.pas | 592 ++++ .../turbopower_ipro/test_cases/ipro_tests.pas | 48 + .../test_cases/iprotest_unit.pas | 23 +- components/turbopower_ipro/turbopoweripro.lpk | 14 +- components/turbopower_ipro/turbopoweripro.pas | 3 +- 10 files changed, 4898 insertions(+), 267 deletions(-) create mode 100644 components/turbopower_ipro/ipcss.pas create mode 100644 components/turbopower_ipro/iphtmlparser.pas create mode 100644 components/turbopower_ipro/iphtmlutils.pas diff --git a/components/turbopower_ipro/ipcss.pas b/components/turbopower_ipro/ipcss.pas new file mode 100644 index 0000000000..fb5d688a1e --- /dev/null +++ b/components/turbopower_ipro/ipcss.pas @@ -0,0 +1,836 @@ +unit IpCSS; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, Contnrs, SysUtils, Graphics, + IpHtmlProp, IpHtmlUtils; + +type + TCSSGroup = class + end; + + TCSSFontStyle = (cfsNormal, cfsItalic, cfsOblique, cfsInherit); + TCSSFontWeight = (cfwNormal, cfwBold, cfwBolder, cfwLighter, cfw100, cfw200, + cfw300, cfw400 , cfw500, cfw600, cfw700, cfw800, cfw900); + TCSSFontVariant = (cfvNormal, cfvSmallCaps, cfvInherit); + + TCSSBorderStyle = (cbsNone, cbsHidden, cbsDotted, cbsDashed, cbsSolid, cbsDouble, + cbsGroove, cbsRidge, cbsInset, cbsOutset); + TCSSMarginStyle = (cmsNone, + cmsAuto, // use default + cmsPx, // pixel + cmsPt, cmsEm, cmsPercent // currently not supported + ); + + TCSSMargin = record + Style: TCSSMarginStyle; + Size: single; // negative values are allowed (not implemented) + end; + + TCSSLengthType = (cltUndefined, cltAbsolute, cltPercent); + TCSSLength = record + LengthValue: Integer; + LengthType: TCSSLengthType + end; + + { TCSSFont } + + TCSSFont = class + private + FFamily: String; + FSize: String; + FStyle: TCSSFontStyle; + FWeight: TCSSFontWeight; + published + property Name: String read FFamily write FFamily; + property Size: String read FSize write FSize; + property Style: TCSSFontStyle read FStyle write FStyle; + //proprety Variant: TCSSFontVariant + property Weight: TCSSFontWeight read FWeight write FWeight; + end; + + { TCSSBorder } + + TCSSBorder = class + private + FColor: TColor; + FStyle: TCSSBorderStyle; + FWidth: Integer; + public + constructor Create; + published + property Color: TColor read FColor write FColor; + property Style: TCSSBorderStyle read FStyle write FStyle; + property Width: Integer read FWidth write FWidth; + end; + + { TCSSProps represents a set of properties from the CSS stylesheet, for + example everything within one selector or the contents of a style attribute + or even many applicable CSS styles for one node merged into one. It has + methods for parsing CSS text and for merging two such objects into one} + TCSSProps = class + private + FBorder: TCSSBorder; + FClassIDs: TStringList; + FBGColor: TColor; + FBorderBottom: TCSSBorderStyle; + FBorderLeft: TCSSBorderStyle; + FBorderRight: TCSSBorderStyle; + FBorderTop: TCSSBorderStyle; + FColor: TColor; + FFont: TCSSFont; + FAlignment: TIpHtmlAlign; + FMarginBottom: TCSSMargin; + FMarginLeft: TCSSMargin; + FMarginRight: TCSSMargin; + FMarginTop: TCSSMargin; + FWidth: TCSSLength; + function GetCommandArgs(ACommand: String): TStringList; + function GetCommandName(ACommand: String): String; + public + property MarginTop: TCSSMargin read FMarginTop write FMarginTop; + property MarginLeft: TCSSMargin read FMarginLeft write FMarginLeft; + property MarginBottom: TCSSMargin read FMarginBottom write FMarginBottom; + property MarginRight: TCSSMargin read FMarginRight write FMarginRight; + property Width: TCSSLength read FWidth write FWidth; + published + property Font: TCSSFont read FFont write FFont; + property Color: TColor read FColor write FColor; + property BGColor: TColor read FBGColor write FBGColor; + property Border: TCSSBorder read FBorder write FBorder; + property BorderTop: TCSSBorderStyle read FBorderTop write FBorderTop; + property BorderLeft: TCSSBorderStyle read FBorderLeft write FBorderLeft; + property BorderBottom: TCSSBorderStyle read FBorderBottom write FBorderBottom; + property BorderRight: TCSSBorderStyle read FBorderRight write FBorderRight; + property Alignment: TIpHtmlAlign read FAlignment write FAlignment; + public + constructor Create; + destructor Destroy; override; + procedure ReadCommands(ACommands: TStrings); + procedure MergeAdditionalProps(AProps: TCSSProps); + end; + + { TCSSGlobalProps serves as a global list of TCSSProps objects, it is + populated when parsing the CSS and then used to look up the CSS styles + for a certain CSS selector (the selector is supplied as a string and it + returns a reference to the TCSSProps object for this selector). The + contained TCSSProps objects are created and owned by TCSSGlobalProps } + TCSSGlobalProps = class + FElements: TFPObjectHashTable; + protected + {$IFDEF IP_LAZARUS_DBG} + procedure DoDumpProps(Item: TObject; const Key: String; var Continue: Boolean); + {$ENDIF} + public + constructor Create; + destructor Destroy; override; + {$IFDEF IP_LAZARUS_DBG} + procedure DumpProps; + {$ENDIF} + function GetPropsObject(ATagName: String; AClassID: String = ''; CreateIfNotExist: Boolean = False): TCSSProps; + end; + + TCSSReader = class + FStream: TStream; + FGlobalProps: TCSSGlobalProps; + function GetStatementElements(AStatement: String): TStringList; + function GetStatementCommands(AStatement: String): TStringList; + function CheckIsComment: Boolean; + procedure EatWhiteSpace; + procedure ParseCSS; + procedure EatComment; + function FindStatement(out AStatement: String): Boolean; + function EOF: Boolean; + constructor Create(AStream: TStream; AGlobalProps: TCSSGlobalProps); + end; + +function SeparateCommands(Commands: String): TStringList; + +implementation + +uses + LazStringUtils; + +function ForceRange(x, xmin, xmax: Integer): Integer; +begin + if x < xmin then + Result := xmin + else if x > xmax then + Result := xmax + else + Result := x; +end; + +function IsWhiteSpace(AChar: Char; ExcludeSpaces: Boolean = False): Boolean; +begin + Result := AChar in [#9, #10, #11, #13]; + if not Result and not ExcludeSpaces then + Result := AChar = ' '; +end; + +function StrToCSSLength(AValue: String): TCssLength; +var + P, Err: Integer; +begin + P := Pos('%', AValue); + if P <> 0 then begin + Result.LengthType := cltPercent; + Delete(AValue, P, 1); + end else + Result.LengthType := cltAbsolute; + val(AValue, Result.LengthValue, Err); + if (Err <> 0) or (Result.LengthValue < 0) then + Result.LengthType := cltUndefined + else if (Result.LengthType = cltPercent) and (Result.LengthValue > 100) then + Result.LengthValue := 100; +end; + +function SeparateCommands(Commands: String): TStringList; +var + i, fpos1, fpos2: Integer; + Command: String; +begin + Result := TStringList.Create; + FPos1 := 1; + + for i := 1 to Length(Commands) do + begin + if Commands[i] = ';' then + begin + Command := Copy(Commands, FPos1, i-FPos1); + FPos1 := i+1; + for FPos2 := Length(Command) downto 1 do + if IsWhiteSpace(Command[FPos2], True) then + Delete(Command, FPos2, 1); + Result.Add(Trim(Command)); + end; + end; + Command := Trim(Copy(Commands, FPos1, Length(Commands))); + if Command <> '' then + begin + Result.Add(Command); + end; +end; + +function FontWeightFromString(S: String): TCSSFontWeight; +begin + Result := cfwNormal; + S := trim(S); + case S[1] of + '1': if S = '100' then Result := cfw100; + '2': if S = '200' then Result := cfw200; + '3': if S = '300' then Result := cfw300; + '4': if S = '400' then Result := cfw400; + '5': if S = '500' then Result := cfw500; + '6': if S = '600' then Result := cfw600; + '7': if S = '700' then Result := cfw700; + '8': if S = '800' then Result := cfw800; + '9': if S = '900' then Result := cfw900; + 'B','b': if CompareText(S, 'bold') = 0 then Result := cfwBold + else if CompareText(S, 'bolder') = 0 then Result := cfwBolder; + 'L','l': if CompareText(S, 'lighter') = 0 then Result := cfwLighter; + end; +end; + +function SizePxFromString(S: String): Integer; +begin + S := Copy(S, 1, PosI('px', S)-1); + Result := StrToIntDef(S, 0); +end; + +function StrToCssMargin(const S: string): TCSSMargin; +var + i: SizeInt; +begin + Result.Style:=cmsAuto; + Result.Size:=0; + if (S='') or (CompareText(S,'auto')=0) then exit; + + i:=PosI('px',S); + if i>0 then begin + Result.Style:=cmsPx; + Result.Size:=StrToIntDef(copy(S,1,i-1),0); + exit; + end; + + i:=PosI('em',S); + if i>0 then begin + Result.Style:=cmsEm; + Result.Size:=StrToIntDef(copy(S,1,i-1),0); + exit; + end; + + i:=Pos('%',S); + if i>0 then begin + Result.Style:=cmsPercent; + Result.Size:=StrToIntDef(copy(S,1,i-1),0); + exit; + end; + + // a number without unit is px + Result.Style:=cmsPx; + Result.Size:=StrToIntDef(S,0); +end; + +function CSSFontStyleFromName(S: String): TCSSFontStyle; +begin + Result := cfsNormal; + if length(s)<2 then exit; + case S[2] of + 'b': if S = 'oblique' then Result := cfsOblique; + 'n': if S = 'inherit' then Result := cfsInherit; + 't': if S = 'italic' then Result := cfsItalic; + end; +end; + +function BorderStyleFromString(S: String): TCSSBorderStyle; +begin + Result := cbsNone; + S := LowerCase(S); + case S[1] of + 'd': + if S = 'dotted' then + Result := cbsDotted + else + if S = 'dashed' then + Result := cbsDashed + else + if S = 'double' then + Result := cbsDouble; + 'g': if S = 'groove' then Result := cbsGroove; + 'h': if S = 'hidden' then Result := cbsHidden; + 'i': if S = 'inset' then Result := cbsInset; + 'o': if S = 'outset' then Result := cbsOutset; + 'r': if S = 'ridge' then Result := cbsRidge; + 's': if S = 'solid' then Result := cbsSolid; + end; +end; + + +{ TCSSReader } + +function TCSSReader.GetStatementElements(AStatement: String): TStringList; +var + i, fpos: Integer; + Elements : String; + Element: String; + ElementClass: String; +begin + Result := TStringList.Create; + fpos := Pos('{', AStatement); + if fpos > 0 then + begin + Elements := Copy(AStatement,1,fpos-1); + for i := Length(Elements) downto 1 do + if IsWhiteSpace(Elements[i]) then + Delete(Elements, i, 1); + Result.Delimiter := ','; + Result.DelimitedText := Elements; + end; + + for i := 0 to Result.Count-1 do begin + {$IFDEF CSS_CASESENSITIVE_CLASSID} + Element := Result[i]; + {$ELSE} + Element := LowerCase(Result[i]); + {$ENDIF} + ElementClass := ''; + fpos := Pos('.', Element); + if fpos = 0 then + begin + Result.Objects[i] := FGlobalProps.GetPropsObject(Element, '', True); + end + else begin + {$IFDEF CSS_CASESENSITIVE_CLASSID} + ElementClass := Copy(Element, FPos+1, Length(Element)); + Element := Copy(Element, 1, FPos-1); + {$ELSE} + ElementClass := LowerCase(Copy(Element, FPos+1, Length(Element))); + Element := LowerCase(Copy(Element, 1, FPos-1)); + {$ENDIF} + Result.Objects[i] := FGlobalProps.GetPropsObject(Element, ElementClass, True); + end; + end; + +end; + +function TCSSReader.GetStatementCommands(AStatement: String): TStringList; +var + fpos1, fpos2: Integer; + Commands: String; +begin + fpos1 := Pos('{', AStatement)+1; + fpos2 := Pos('}', AStatement)-1; + Commands := Copy(AStatement, fpos1, fpos2-fpos1+1); + Result := SeparateCommands(Commands); +end; + +function TCSSProps.GetCommandArgs(ACommand: String): TStringList; +var + i: Integer; + WantArg: Boolean; + Arg: String; + Start: Integer; + Quote: char; + WantChar: Boolean; + WantPar: Boolean; + Len: Integer; +begin + Result := TStringList.Create; + Start := Pos(':', ACommand)+1; + + WantArg := True; + WantPar := false; + Quote := #0; + for i := Start to Length(ACommand) do + begin + if (Quote = #0) and (ACommand[i] in ['"','''']) then + begin + Quote := ACommand[i]; + Start := i+1; + continue; + end; + if Quote<>#0 then begin + if ACommand[i]=Quote then begin + Quote:=#0; + Arg := Copy(ACommand, Start, i-Start); + Result.Add(Arg); + end; + continue; + end; + if WantArg then + begin + if IsWhiteSpace(ACommand[i]) then + Continue; + Start := i; + WantArg := False; + continue; + end + else // we have an arg we are reading ... + begin + WantChar:=not (ACommand[i] in [';',' ',#9]); + if ACommand[i] = '(' then WantPar := True; + if ACommand[i] = ')' then WantPar := False; + if (i '*/') do + begin + Buf[0] := Buf[1]; + FStream.Read(Buf[1], 1); + end; +end; + +function TCSSReader.FindStatement(out AStatement: String): Boolean; +var + Buf: char; + Buf1: string; + RCount: Integer; + FStart, FEnd: Integer; +begin + Result := False; + EatWhiteSpace; + + AStatement := ''; + + SetLength(Buf1,1023); + FStart := FStream.Position; + while not EOF do + begin + + Buf := Char(FStream.ReadByte); + FEnd := FStream.Position; + if (Buf = '/') and CheckIsComment then + begin + FStream.Position := FStart; + if length(Buf1)= FStream.Size; +end; + +constructor TCSSReader.Create(AStream: TStream; AGlobalProps: TCSSGlobalProps); +begin + inherited Create; + FStream := AStream; + FGlobalProps:= AGlobalProps; +end; + +{ TCSSProps } + +constructor TCSSProps.Create; +begin + FFont := TCSSFont.Create; + FBGColor := clNone; + FColor := clNone; + FAlignment := haUnknown; + FBorder := TCSSBorder.Create; + FWidth.LengthType := cltUndefined; +end; + +destructor TCSSProps.Destroy; +var + i: Integer; +begin + if Assigned(FClassIDs) then + begin + for i := 0 to FClassIDs.Count-1 do + FClassIDs.Objects[i].Free; + FClassIDs.Free; + end; + FFont.Free; + FBorder.Free; + inherited Destroy; +end; + +procedure TCSSProps.ReadCommands(ACommands: TStrings); +var + Args: TStringlist; + ACommand: String; + Cmd: String; + I: Integer; +begin + for I := 0 to ACommands.Count-1 do + begin + ACommand := ACommands[I]; + if ACommand='' then continue; + Cmd := LowerCase(GetCommandName(ACommand)); + if Cmd='' then continue; + + Args := GetCommandArgs(ACommand); + try + case Cmd[1] of + 'c': if Cmd = 'color' then + if Args.Count > 0 then + Color := ColorFromString(Args[0]) + else + Color := clDefault; + + 'b': if Cmd = 'background-color' then begin + if Args.Count > 0 then + BGColor := ColorFromString(Args[0]) + else + BGColor := clDefault; + end else + if Cmd = 'background' then + begin + if Args.Count > 0 then BGColor := ColorFromString(Args[0]); + if Args.Count > 1 then ; // background image + if Args.Count > 2 then ; // background image repeat + if Args.Count > 3 then ; // background attachment + if Args.Count > 4 then ; // background position + end + else if Cmd = 'border' then + begin + if Args.Count > 0 then Border.Width := SizePxFromString(Args[0]); + if Args.Count > 1 then Border.Style := BorderStyleFromString(Args[1]); + if Args.Count > 2 then Border.Color := ColorFromString(Args[2]); + end + else if Cmd = 'border-width' then + begin + if Args.Count > 0 then Border.Width := SizePxFromString(Args[0]); + end + else if Cmd = 'border-color' then + begin + if Args.Count > 0 then Border.Color := ColorFromString(Args[0]); + end + else if Cmd = 'border-style' then + begin + if Args.Count > 0 then Border.Style := BorderStyleFromString(Args[0]); + end; + + 'm': + if Cmd = 'margin-top' then begin + if Args.Count > 0 then MarginTop := StrToCssMargin(Args[0]); + end + else if Cmd = 'margin-left' then begin + if Args.Count > 0 then MarginLeft := StrToCssMargin(Args[0]); + end + else if Cmd = 'margin-bottom' then begin + if Args.Count > 0 then MarginBottom := StrToCssMargin(Args[0]); + end else if Cmd = 'margin-right' then begin + if Args.Count > 0 then MarginRight := StrToCssMargin(Args[0]); + end else if Cmd = 'margin' then begin + case Args.Count of + 1:begin + // 1 arg: all four the same + MarginTop := StrToCssMargin(Args[0]); + MarginBottom := MarginTop; + MarginLeft := MarginTop; + MarginRight := MarginTop; + end; + 2:begin + // 2 args: top+bottom and left+right + MarginTop := StrToCssMargin(Args[0]); + MarginBottom := MarginTop; + MarginLeft := StrToCssMargin(Args[1]); + MarginRight := MarginLeft; + end; + 3:begin + // 3 args: top right bottom + MarginTop := StrToCssMargin(Args[0]); + MarginRight := StrToCssMargin(Args[1]); + MarginBottom := StrToCssMargin(Args[2]); + end; + 4:begin + // 4 args: top right bottom left + MarginTop := StrToCssMargin(Args[0]); + MarginRight := StrToCssMargin(Args[1]); + MarginBottom := StrToCssMargin(Args[2]); + MarginLeft := StrToCssMargin(Args[3]); + end; + end; + end; + + 't': if (Cmd = 'text-align') then + begin + if Args.Count > 0 then Alignment := GetAlignmentForStr(Args[0]); + end; + + 'f': + if (Length(Cmd) > 7) and (Args.Count > 0) then + case Cmd[7] of + 'a': if (Cmd = 'font-family') then + Font.Name := Args.CommaText; //Args[0]; + 'i': if (Cmd = 'font-size') then + Font.Size := Args[0]; + 't': if (Cmd = 'font-style') then + Font.Style := CSSFontStyleFromName(Args[0]); + 'e': if (Cmd = 'font-weight') then + Font.Weight := FontWeightFromString(Args[0]); + end; + 'w': + if (Cmd = 'width') and (Args.Count > 0) then + FWidth := StrToCSSLength(Args[0]); + end; + finally + Args.Free; + end; + end; +end; + +procedure TCSSProps.MergeAdditionalProps(AProps: TCSSProps); +begin + if AProps.Color <> clNone then Color := AProps.Color; + if AProps.BGColor <> clNone then BGColor := AProps.BGColor; + if AProps.Alignment <> haUnknown then Alignment := AProps.Alignment; + if AProps.Font.Name <> '' then Font.Name := AProps.Font.Name; + if AProps.Font.Size <> '' then Font.Size := AProps.Font.Size; + if AProps.Font.Style <> cfsNormal then Font.Style := AProps.Font.Style; + if AProps.Font.Weight <> cfwNormal then Font.Weight := AProps.Font.Weight; + + if AProps.MarginBottom.Style <> cmsNone then + FMarginBottom.Style := AProps.MarginBottom.Style; + if AProps.MarginBottom.Size <> 0 then + FMarginBottom.Size := AProps.MarginBottom.Size; + + if AProps.MarginLeft.Style <> cmsNone then + FMarginLeft.Style := AProps.MarginLeft.Style; + if AProps.MarginLeft.Size <> 0 then + FMarginLeft.Size := AProps.MarginLeft.Size; + + if AProps.MarginRight.Style <> cmsNone then + FMarginRight.Style := AProps.MarginRight.Style; + if AProps.MarginRight.Size <> 0 then + FMarginRight.Size := AProps.MarginRight.Size; + + if AProps.MarginTop.Style <> cmsNone then + FMarginTop.Style := AProps.MarginTop.Style; + if AProps.MarginTop.Size <> 0 then + FMarginTop.Size := AProps.MarginTop.Size; + + if AProps.Width.LengthType <> cltUndefined then + FWidth := AProps.Width; +end; + + +{ TCSSGlobalProps } + +constructor TCSSGlobalProps.Create; +begin + FElements := TFPObjectHashTable.Create(True); +end; + +destructor TCSSGlobalProps.Destroy; +begin + FElements.Free; + inherited Destroy; +end; + +{$IFDEF IP_LAZARUS_DBG} +procedure TCSSGlobalProps.DoDumpProps(Item: TObject; const Key: String; var Continue: Boolean); +var + lProp: TCSSProps; +begin + lProp := TCSSProps(Item); + WriteLn('CSS for >>>: ', Key); + WriteLn(' Color : ', lProp.Color); + WriteLn(' BgColor : ', lProp.BGColor); + WriteLn(' Font : ', lProp.Font.Name, ':', lProp.Font.FFamily, ':', lProp.Font.Size); + WriteLn(' Align : ' + GetEnumName(TypeInfo(TIpHtmlAlign), ord(lProp.Alignment))); +end; + +procedure TCSSGlobalProps.DumpProps; +begin + FElements.Iterate(DoDumpProps); +end; +{$endif} + +function TCSSGlobalProps.GetPropsObject(ATagName: String; + AClassID: String; CreateIfNotExist: Boolean): TCSSProps; +var + Selector: String; + + procedure Lookup(const AName: String); + begin + if length(AClassID) > 0 then + {$IFDEF CSS_CASESENSITIVE_CLASSID} + Selector := AName + '.' + AClassID + {$ELSE} + Selector := AName + '.' + Lowercase(AClassID) + {$ENDIF} + else + Selector := AName; + + // The css selectors are already lowercase, this is + // already done in the css parser. And the html parser + // can only deliver its own built-in tag names anyways. + // Also the names are not expected to be longer than + // ShortString (this would need to be a ridiculously + // long ClassID), should this ever happen then + // it would be silently truncated in the following + // type conversion to ShortString. + Result := TCSSProps(FElements.Items[Selector]); + end; + +begin + Result := nil; + if (length(AClassID) = 0) and (length(ATagName) = 0) then + exit; + + Lookup(ATagName); + if (Result=nil) and not CreateIfNotExist then + Lookup('*'); + + if (Result = nil) and CreateIfNotExist then + begin + Result := TCSSProps.Create; + FElements.Add(Selector, Result); + end; +end; + + +{ TCSSBorder } + +constructor TCSSBorder.Create; +begin + inherited Create; + FWidth := -1; + FColor := clBlack; + FStyle := cbsNone; +end; + +end. +end. + diff --git a/components/turbopower_ipro/iphtml.pas b/components/turbopower_ipro/iphtml.pas index 010e4388bd..210544bd97 100644 --- a/components/turbopower_ipro/iphtml.pas +++ b/components/turbopower_ipro/iphtml.pas @@ -72,7 +72,7 @@ uses {$ENDIF} TypInfo, GraphUtil, Controls, StdCtrls, ExtCtrls, Buttons, Forms, ClipBrd, Dialogs, - IpConst, IpStrms, IpUtils, iphtmlprop, IpMsg; + IpConst, IpStrms, IpUtils, iphtmlprop, IpMsg, IpCSS, IpHtmlUtils; type {Note: Some of the code below relies on the fact that @@ -80,6 +80,9 @@ type {$I iphtmlgenerated.inc} +type + TParmValueArray = array[TIpHtmlAttributesSet] of string; + const IPMAXFRAMES = 256; {maximum number of frames in a single frameset} MAXINTS = 4096; {buffer size - this should be way more than needed} @@ -102,12 +105,12 @@ type end; TIpHtml = class; - + TIpAbstractHtmlDataProvider = class; - {$DEFINE CSS_INTERFACE} -{$I ipcss.inc} - {$UNDEF CSS_INTERFACE} +// {$DEFINE CSS_INTERFACE} +//{$I ipcss.inc} +// {$UNDEF CSS_INTERFACE} TIpHtmlInteger = class(TPersistent) { Integer property which can be scaled} @@ -373,19 +376,19 @@ type procedure AddArea(const R: TRect); procedure BuildAreaList; virtual; procedure ClearAreaList; virtual; - procedure ParseBaseProps(aOwner : TIpHtml); function SelectCSSFont(const aFont: string): string; procedure ApplyCSSProps(const ACSSProps: TCSSProps; const props: TIpHtmlProps); - function ElementName: String; function GetAlign: TIpHtmlAlign; virtual; function GetFontSizeFromCSS(CurrentFontSize:Integer; aFontSize: string):Integer; procedure SetAlign(const Value: TIpHtmlAlign); virtual; procedure SetId(const Value: string); virtual; + property ElementName: String read FElementName write FElementName; public constructor Create(ParentNode : TIpHtmlNode); destructor Destroy; override; procedure LoadAndApplyCSSProps; virtual; procedure MakeVisible; override; + procedure ParseBaseProps(aOwner : TIpHtml); property InlineCSS: TCSSProps read FInlineCSSProps write FInlineCSSProps; property Align: TIpHtmlAlign read GetAlign write SetAlign; property ClassId : string read FClassId write FClassId; @@ -569,10 +572,10 @@ type procedure SetFace(const Value: string); protected procedure ApplyProps(const RenderProps: TIpHtmlProps); override; - procedure SizeChanged(Sender: TObject); public constructor Create(ParentNode : TIpHtmlNode); destructor Destroy; override; + procedure SizeChanged(Sender: TObject); {$IFDEF HTML_RTTI} published {$ENDIF} @@ -616,6 +619,7 @@ type procedure Enqueue; override; procedure LoadAndApplyCSSProps; override; procedure SetProps(const RenderProps: TIpHtmlProps); override; + property ElementName; {$IFDEF HTML_RTTI} published {$ENDIF} @@ -750,10 +754,10 @@ type FVersion: string; FDir: TIpHtmlDirection; protected - function HasBodyNode : Boolean; procedure CalcMinMaxHtmlWidth(const RenderProps: TIpHtmlProps; var Min, Max: Integer); function GetHeight(const RenderProps: TIpHtmlProps; const Width: Integer): Integer; public + function HasBodyNode : Boolean; procedure Layout(const RenderProps: TIpHtmlProps; const TargetRect : TRect); procedure Render(RenderProps: TIpHtmlProps); {$IFDEF HTML_RTTI} @@ -874,9 +878,9 @@ type function Successful: Boolean; override; procedure AddValues(NameList, ValueList : TStringList); override; procedure Reset; override; - procedure WidthChanged(Sender: TObject); public destructor Destroy; override; + procedure WidthChanged(Sender: TObject); {$IFDEF HTML_RTTI} published {$ENDIF} @@ -1041,7 +1045,6 @@ type SizeWidth : TIpHtmlPixels; FDim : TSize; function GrossDrawRect: TRect; - procedure WidthChanged(Sender: TObject); public constructor Create(ParentNode : TIpHtmlNode); destructor Destroy; override; @@ -1049,6 +1052,7 @@ type procedure CalcMinMaxWidth(var Min, Max: Integer); override; procedure Enqueue; override; function GetDim(ParentWidth: Integer): TSize; override; + procedure WidthChanged(Sender: TObject); {$IFDEF HTML_RTTI} published {$ENDIF} @@ -1160,7 +1164,6 @@ type procedure UnloadImage; function GrossDrawRect: TRect; function GetHint: string; override; - procedure DimChanged(Sender: TObject); procedure InvalidateSize; override; public constructor Create(ParentNode : TIpHtmlNode); @@ -1170,6 +1173,7 @@ type procedure CalcMinMaxWidth(var Min, Max: Integer); override; function GetDim(ParentWidth: Integer): TSize; override; procedure ImageChange(NewPicture : TPicture); override; + procedure DimChanged(Sender: TObject); {$IFDEF HTML_RTTI} published {$ENDIF} @@ -1202,9 +1206,9 @@ type FAlignment: TIpHtmlImageAlign; protected function GetHint: string; override; - procedure WidthChanged(Sender: TObject); public destructor Destroy; override; + procedure WidthChanged(Sender: TObject); {$IFDEF HTML_RTTI} published {$ENDIF} @@ -1242,9 +1246,9 @@ type FVSpace: Integer; FWidth: TIpHtmlLength; protected - procedure WidthChanged(Sender: TObject); public destructor Destroy; override; + procedure WidthChanged(Sender: TObject); {$IFDEF HTML_RTTI} published {$ENDIF} @@ -1456,7 +1460,6 @@ type procedure SetRect(TargetRect: TRect); override; procedure InvalidateSize; override; function GetColCount: Integer; - procedure WidthChanged(Sender: TObject); public FCaption : TIpHtmlNodeCAPTION; BorderRect : TRect; @@ -1470,6 +1473,7 @@ type procedure Enqueue; override; function GetDim(ParentWidth: Integer): TSize; override; procedure LoadAndApplyCSSProps; override; + procedure WidthChanged(Sender: TObject); {$IFDEF HTML_RTTI} published {$ENDIF} @@ -1622,7 +1626,6 @@ type FVAlign: TIpHtmlVAlign3; protected procedure AppendSelection(var S: String; var Completed: Boolean); override; - procedure DimChanged(Sender: TObject); function GetAlign: TIpHtmlAlign; override; procedure SetAlign(const Value: TIpHtmlAlign); override; public @@ -1633,6 +1636,7 @@ type procedure LoadAndApplyCSSProps; override; procedure Render(RenderProps: TIpHtmlProps); override; procedure CalcMinMaxPropWidth(RenderProps: TIpHtmlProps; var Min, Max: Integer); override; + procedure DimChanged(Sender: TObject); public property PadRect : TRect read FPadRect write FPadRect; {$IFDEF HTML_RTTI} @@ -1869,6 +1873,12 @@ type property Align : TIpHtmlVAlignment2 read FAlign write FAlign; end; + TIpHtmlBasicParser = class + public + function Execute: Boolean; virtual; abstract; + function FindAttribute(const AttrNameSet: TIpHtmlAttributesSet): string; virtual; abstract; + end; + TIpHtmlRenderDevice = (rdScreen, rdPrinter, rdPreview); TWriteCharProvider = procedure(C : AnsiChar) of object; @@ -1945,23 +1955,24 @@ type FRenderDev: TIpHtmlRenderDevice; FCSS: TCSSGlobalProps; FDocCharset: string; - FHasBOM: boolean; +// FHasBOM: boolean; FTabList: TIpHtmlTabList; FNeedResize: Boolean; + FParser: TIpHtmlBasicParser; protected CharStream : TStream; - CurToken : TIpHtmlToken; - ParmValueArray : array[TIpHtmlAttributesSet] of string; +// CurToken : TIpHtmlToken; +// ParmValueArray: TParmValueArray; FHtml : TIpHtmlNodeHtml; - CharStack : array [0..7] of AnsiChar; - LastWasSpace: Boolean; - LastWasClose: Boolean; - CharSP : Integer; +// CharStack : array [0..7] of AnsiChar; +// LastWasSpace: Boolean; +// LastWasClose: Boolean; +// CharSP : Integer; FFlagErrors : Boolean; - IndexPhrase : string; - TokenBuffer : TIpHtmlToken; +// IndexPhrase : string; +// TokenBuffer : TIpHtmlToken; FPageRect : TRect; - HaveToken : Boolean; +// HaveToken : Boolean; FClientRect : TRect; {the coordinates of the paint rectangle} FPageViewRect : TRect; {the current section of the page} FPageViewBottom : Integer; {the lower end of the page, may be different from PageViewRect.Bottom } @@ -1982,17 +1993,17 @@ type NameList : TStringList; IdList: TStringList; GifQueue : TFPList; - InPre : Integer; - InBlock : Integer; +// InPre : Integer; +// InBlock : Integer; MapList : TFPList; AreaList : TFPList; DefaultImage : TPicture; MapImgList : TFPList; - GlobalPos, LineNumber, LineOffset : Integer; +// GlobalPos, LineNumber, LineOffset : Integer; PaintBufferBitmap : TBitmap; PaintBuffer : TCanvas; - TokenStringBuf : PChar; {array[16383] of AnsiChar;} - TBW : Integer; +// TokenStringBuf : PChar; {array[16383] of AnsiChar;} +// TBW : Integer; Destroying : Boolean; FAllSelected : Boolean; RectList : TFPList; @@ -2002,17 +2013,17 @@ type FControlList : TFPList; FCurURL : string; DoneLoading : Boolean; - ListLevel : Integer; +// ListLevel : Integer; PropACache : TIpHtmlPropsAList; PropBCache : TIpHtmlPropsBList; RenderCanvas : TCanvas; FPageHeight : Integer; - StartPos : Integer; +// StartPos : Integer; FFixedTypeface: string; FDefaultTypeFace: string; FDefaultFontSize: integer; - ParmBuf: PChar; - ParmBufSize: Integer; +// ParmBuf: PChar; +// ParmBufSize: Integer; FControlParent: TWinControl; procedure ResetCanvasData; procedure ResetWordLists; @@ -2022,123 +2033,123 @@ type function CheckKnownURL(URL: string): boolean; procedure ReportReference(URL: string); procedure PaintSelection; - function IsWhiteSpace: Boolean; - function GetTokenString: string; - procedure ReportError(const ErrorMsg: string); - procedure ReportExpectedError(const ErrorMsg: string); - procedure ReportExpectedToken(const Token: TIpHtmlToken); - procedure EnsureClosure(const EndToken: TIpHtmlToken; const EndTokens: TIpHtmlTokenSet); +// function IsWhiteSpace: Boolean; +// function GetTokenString: string; +// procedure ReportError(const ErrorMsg: string); +// procedure ReportExpectedError(const ErrorMsg: string); +// procedure ReportExpectedToken(const Token: TIpHtmlToken); +// procedure EnsureClosure(const EndToken: TIpHtmlToken; const EndTokens: TIpHtmlTokenSet); function NewElement(EType : TElementType; Own: TIpHtmlNode) : PIpHtmlElement; function BuildStandardEntry(EType: TElementType): PIpHtmlElement; function BuildLinefeedEntry(EType: TElementType; AHeight: Integer): PIpHtmlElement; - function ParseDir: TIpHtmlDirection; - procedure ParseSPAN(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseQ(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseINS(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseDEL(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseTABLE(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseTableBody(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseTableRows(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseColGroup(Parent: TIpHtmlNode); - function ParseFrameScrollingProp: TIpHtmlFrameScrolling; - function ParseObjectValueType: TIpHtmlObjectValueType; - procedure ParseFrameSet(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseFrame(Parent : TIpHtmlNode); - procedure ParseIFrame(Parent : TIpHtmlNode); - procedure ParseNOFRAMES(Parent : TIpHtmlNode); - function ParseButtonType: TIpHtmlButtonType; - procedure ParseNoscript(Parent: TIpHtmlNode); - procedure ParseLEFT(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseBLINK(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseRIGHT(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure PutToken(Token: TIpHtmlToken); - procedure ParseParagraph(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseListItems(Parent : TIpHtmlNodeCore; - EndToken: TIpHtmlToken; const EndTokens : TIpHtmlTokenSet; - DefaultListStyle : TIpHtmlULType); - procedure ParseUnorderedList(Parent: TIpHtmlNode; - EndToken : TIpHtmlToken; const EndTokens: TIpHtmlTokenSet); - procedure ParseOrderedList(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); - procedure ParseDefinitionList(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseDefListItems(Parent: TIpHtmlNode; - const EndTokens: TIpHtmlTokenSet); - procedure ParsePre(ParentNode : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseDIV(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseCENTER(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseBLOCKQUOTE(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseHR(Parent: TIpHtmlNode); - procedure ParseFontStyle(Parent: TIpHtmlNode; - StartToken : TIpHtmlToken; const EndTokens: TIpHtmlTokenSet); - procedure ParsePhraseElement(Parent: TIpHtmlNode; - StartToken, EndToken: TIpHtmlToken; const EndTokens: TIpHtmlTokenSet); - procedure ParseAnchor(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); - procedure ParseIMG(Parent : TIpHtmlNode); - procedure ParseApplet(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); - procedure ParseOBJECT(Parent : TIpHtmlNode); - procedure ParseBasefont(Parent: TIpHtmlNode); - procedure ParseBR(Parent : TIpHtmlNode); - procedure ParseNOBR(Parent: TIpHtmlNode); - procedure ParseMAP(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// function ParseDir: TIpHtmlDirection; +// procedure ParseSPAN(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseQ(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseINS(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseDEL(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseTABLE(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseTableBody(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseTableRows(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseColGroup(Parent: TIpHtmlNode); +// function ParseFrameScrollingProp: TIpHtmlFrameScrolling; +// function ParseObjectValueType: TIpHtmlObjectValueType; +// procedure ParseFrameSet(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseFrame(Parent : TIpHtmlNode); +// procedure ParseIFrame(Parent : TIpHtmlNode); +// procedure ParseNOFRAMES(Parent : TIpHtmlNode); +// function ParseButtonType: TIpHtmlButtonType; +// procedure ParseNoscript(Parent: TIpHtmlNode); +// procedure ParseLEFT(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseBLINK(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseRIGHT(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure PutToken(Token: TIpHtmlToken); +// procedure ParseParagraph(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseListItems(Parent : TIpHtmlNodeCore; +// EndToken: TIpHtmlToken; const EndTokens : TIpHtmlTokenSet; +// DefaultListStyle : TIpHtmlULType); +// procedure ParseUnorderedList(Parent: TIpHtmlNode; +// EndToken : TIpHtmlToken; const EndTokens: TIpHtmlTokenSet); +// procedure ParseOrderedList(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); +// procedure ParseDefinitionList(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseDefListItems(Parent: TIpHtmlNode; +// const EndTokens: TIpHtmlTokenSet); +// procedure ParsePre(ParentNode : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseDIV(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseCENTER(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseBLOCKQUOTE(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseHR(Parent: TIpHtmlNode); +// procedure ParseFontStyle(Parent: TIpHtmlNode; +// StartToken : TIpHtmlToken; const EndTokens: TIpHtmlTokenSet); +// procedure ParsePhraseElement(Parent: TIpHtmlNode; +// StartToken, EndToken: TIpHtmlToken; const EndTokens: TIpHtmlTokenSet); +// procedure ParseAnchor(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); +// procedure ParseIMG(Parent : TIpHtmlNode); +// procedure ParseApplet(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); +// procedure ParseOBJECT(Parent : TIpHtmlNode); +// procedure ParseBaseFont(Parent: TIpHtmlNode); +// procedure ParseBR(Parent : TIpHtmlNode); +// procedure ParseNOBR(Parent: TIpHtmlNode); +// procedure ParseMAP(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); function FindAttribute(const AttrNameSet: TIpHtmlAttributesSet): string; - function ColorFromString(S: string): TColor; - function ParseAlignment: TIpHtmlAlign; - function ParseCellAlign(Default : TIpHtmlAlign) : TIpHtmlAlign; - function ParseFrameProp(Default: TIpHtmlFrameProp) : TIpHtmlFrameProp; - function ParseRules(Default : TIpHtmlRules) : TIpHtmlRules; - function ParseULStyle(Default : TIpHtmlULType): TIpHtmlULType; - function ParseBoolean(const AttrNameSet: TIpHtmlAttributesSet): Boolean; - function ParseInteger(const AttrNameSet: TIpHtmlAttributesSet; - aDefault : Integer): Integer; - function ParseHtmlInteger2(const AttrNameSet: TIpHtmlAttributesSet; - aDefault: Integer): TIpHtmlInteger; - function ParsePixels(const AttrNameSet: TIpHtmlAttributesSet; - const aDefault: string): TIpHtmlPixels; - function ParseHyperLength(const AttrNameSet: TIpHtmlAttributesSet; - const aDefault: string): TIpHtmlLength; - function ParseHyperMultiLength(const AttrNameSet: TIpHtmlAttributesSet; - const aDefault: string): TIpHtmlMultiLength; - function ParseHyperMultiLengthList(const AttrNameSet: TIpHtmlAttributesSet; - const aDefault: string): TIpHtmlMultiLengthList; - function ParseOLStyle(Default: TIpHtmlOLStyle): TIpHtmlOLStyle; - function ParseImageAlignment(aDefault: TIpHtmlImageAlign): TIpHtmlImageAlign; - function ParseVAlignment : TIpHtmlVAlign; - function ParseVAlignment2 : TIpHtmlVAlignment2; - function ParseVAlignment3 : TIpHtmlVAlign3; - function ParseRelSize{(const Default: string)}: TIpHtmlRelSize; - function ParseBRClear: TIpHtmlBreakClear; - function ParseShape: TIpHtmlMapShape; - function NextChar : AnsiChar; +// function ColorFromString(S: string): TColor; +// function ParseAlignment: TIpHtmlAlign; +// function ParseCellAlign(Default : TIpHtmlAlign) : TIpHtmlAlign; +// function ParseFrameProp(Default: TIpHtmlFrameProp) : TIpHtmlFrameProp; +// function ParseRules(Default : TIpHtmlRules) : TIpHtmlRules; +// function ParseULStyle(Default : TIpHtmlULType): TIpHtmlULType; +// function ParseBoolean(const AttrNameSet: TIpHtmlAttributesSet): Boolean; +// function ParseInteger(const AttrNameSet: TIpHtmlAttributesSet; +// aDefault : Integer): Integer; +// function ParseHtmlInteger2(const AttrNameSet: TIpHtmlAttributesSet; +// aDefault: Integer): TIpHtmlInteger; +// function ParsePixels(const AttrNameSet: TIpHtmlAttributesSet; +// const aDefault: string): TIpHtmlPixels; +// function ParseHyperLength(const AttrNameSet: TIpHtmlAttributesSet; +// const aDefault: string): TIpHtmlLength; +// function ParseHyperMultiLength(const AttrNameSet: TIpHtmlAttributesSet; +// const aDefault: string): TIpHtmlMultiLength; +// function ParseHyperMultiLengthList(const AttrNameSet: TIpHtmlAttributesSet; +// const aDefault: string): TIpHtmlMultiLengthList; +// function ParseOLStyle(Default: TIpHtmlOLStyle): TIpHtmlOLStyle; +// function ParseImageAlignment(aDefault: TIpHtmlImageAlign): TIpHtmlImageAlign; +// function ParseVAlignment : TIpHtmlVAlign; +// function ParseVAlignment2 : TIpHtmlVAlignment2; +// function ParseVAlignment3 : TIpHtmlVAlign3; +// function ParseRelSize{(const Default: string)}: TIpHtmlRelSize; +// function ParseBRClear: TIpHtmlBreakClear; +// function ParseShape: TIpHtmlMapShape; +// function NextChar : AnsiChar; procedure Parse; - procedure ParseHtml; - function GetChar: AnsiChar; - procedure ClearParmValueArray; - procedure ParmValueArrayAdd(const sName, sValue: string); - function HtmlTokenListIndexOf(const TokenString: PAnsiChar): integer; - procedure NextToken; - procedure PutChar(Ch: AnsiChar); - procedure ParseHead(Parent : TIpHtmlNode); - procedure ParseHeadItems(Parent : TIpHtmlNode); - procedure ParseTitle(Parent: TIpHtmlNode); - procedure ParseScript(Parent : TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); - procedure ParseStyle(ParentNode : TIpHtmlNode); - procedure ParseIsIndex; - procedure ParseBase; - procedure ParseLink(Parent : TIpHtmlNode); - procedure ParseMeta(Parent : TIpHtmlNode); - procedure ParseBody(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseStyleSheet(Parent: TIpHtmlNode; HRef: String); - procedure ParseBodyText(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseBlock(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseInline(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseHeader(Parent : TIpHtmlNode; EndToken : TIpHtmlToken; Size : Integer); - procedure ParseText(const EndTokens: TIpHtmlTokenSet; Parent: TIpHtmlNode); - procedure ParseFont(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - procedure ParseAddress(Parent: TIpHtmlNode); - procedure ParseForm(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); - function ParseMethod: TIpHtmlFormMethod; - procedure ParseTableRow(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); - function ParseInputType : TIpHtmlInputType; - procedure ParseFormFields(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); +// procedure ParseHtml; +// function GetChar: AnsiChar; +// procedure ClearParmValueArray; +// procedure ParmValueArrayAdd(const sName, sValue: string); +// function HtmlTokenListIndexOf(const TokenString: PAnsiChar): integer; +// procedure NextToken; +// procedure PutChar(Ch: AnsiChar); +// procedure ParseHead(Parent : TIpHtmlNode); +// procedure ParseHeadItems(Parent : TIpHtmlNode); +// procedure ParseTitle(Parent: TIpHtmlNode); +// procedure ParseScript(Parent : TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); +// procedure ParseStyle(ParentNode : TIpHtmlNode); +// procedure ParseIsIndex; +// procedure ParseBase; +// procedure ParseLink(Parent : TIpHtmlNode); +// procedure ParseMeta(Parent : TIpHtmlNode); +// procedure ParseBody(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseStyleSheet(Parent: TIpHtmlNode; HRef: String); +// procedure ParseBodyText(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseBlock(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseInline(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseHeader(Parent : TIpHtmlNode; EndToken : TIpHtmlToken; Size : Integer); +// procedure ParseText(const EndTokens: TIpHtmlTokenSet; Parent: TIpHtmlNode); +// procedure ParseFont(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// procedure ParseAddress(Parent: TIpHtmlNode); +// procedure ParseForm(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +// function ParseMethod: TIpHtmlFormMethod; +// procedure ParseTableRow(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); +// function ParseInputType : TIpHtmlInputType; +// procedure ParseFormFields(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); procedure InvalidateRect(R : TRect); procedure SetDefaultProps; function BuildPath(const Ext: string): string; @@ -2148,11 +2159,11 @@ type procedure ClearGifQueue; procedure StartGifPaint(Target: TCanvas); procedure ClearAreaLists; - procedure NextRealToken; - procedure SkipTextTokens; +// procedure NextRealToken; +// procedure SkipTextTokens; procedure BuildAreaList; procedure ClearAreaList; - procedure NextNonBlankToken; +// procedure NextNonBlankToken; procedure Get(const URL: string); procedure Post(const URL: string; FormData: TIpFormDataEntity); procedure ClearRectList; @@ -2212,7 +2223,6 @@ type procedure CheckImage(Picture: TPicture); {$ENDIF} function GetSelectionBlocks(out StartSelIndex,EndSelIndex: Integer): boolean; - property CSS: TCSSGlobalProps read FCSS write FCSS; function getControlCount:integer; function getControl(i:integer):TIpHtmlNode; public @@ -2221,6 +2231,7 @@ type function PagePtToScreen(const Pt: TPoint): TPoint; function PageRectToScreen(const Rect: TRect; var ScreenRect: TRect): Boolean; procedure AddRect(const R: TRect; AElement: PIpHtmlElement; ABlock: TIpHtmlNodeBlock); + procedure FixMissingBodyTag; procedure LoadFromStream(S : TStream); procedure Render(TargetCanvas: TCanvas; TargetPageRect : TRect; UsePaintBuffer: Boolean; const TopLeft: TPoint); overload; @@ -2233,6 +2244,8 @@ type {$ENDIF} property AllSelected : Boolean read FAllSelected; property Body: TIpHtmlNodeBODY read FBody; + property CSS: TCSSGlobalProps read FCSS write FCSS; + property DataProvider: TIpAbstractHtmlDataProvider read FDataProvider; property FlagErrors : Boolean read FFlagErrors write FFlagErrors; property FixedTypeface: string read FFixedTypeface write FFixedTypeface; property DefaultTypeFace: string read FDefaultTypeFace write FDefaultTypeFace; @@ -2400,9 +2413,6 @@ type protected function DoGetHtmlStream(const URL: string; PostData: TIpFormDataEntity) : TStream; virtual; abstract; - function DoGetStream(const URL: string): TStream; virtual; abstract; - {-provider assumes ownership of returned TStream and will free it when - done using it.} function DoCheckURL(const URL: string; var ContentType: string): Boolean; virtual; abstract; procedure DoLeave(Html: TIpHtml); virtual; abstract; @@ -2410,8 +2420,13 @@ type procedure DoGetImage(Sender: TIpHtmlNode; const URL: string; var Picture: TPicture); virtual; abstract; function CanHandle(const URL: string): Boolean; virtual; abstract; - // renamed New,Old to NewURL, OldURL + public + // The following methods were protected in the original but had to be made + // public to cooperate with the TIpHtmlParser function BuildURL(const OldURL, NewURL: string): string; virtual; abstract; + { provider assumes ownership of returned TStream and will free it when + done using it. } + function DoGetStream(const URL: string): TStream; virtual; abstract; end; TIpHtmlEnumerator = procedure(Document: TIpHtml) of object; @@ -2835,8 +2850,6 @@ type TIdFindNodeCriteria = function(ACurrNode: TIpHtmlNodeCore; const AParamStr: string): Boolean; -const - NAnchorChar = #3 ; {character used to represent an Anchor } var // true during print preview only, public to let print preview unit access it ScaleFonts : Boolean = False; @@ -2856,7 +2869,8 @@ function NoBreakToSpace(const S: string): string; procedure SetWordRect(Element: PIpHtmlElement; const Value: TRect); function CalcMultiLength(const List: TIpHtmlMultiLengthList; Avail: Integer; var Sections: Integer): TIntArr; -function GetAlignmentForStr(str: string; pDefault: TIpHtmlAlign = haDefault): TIpHtmlAlign; +//function GetAlignmentForStr(str: string; pDefault: TIpHtmlAlign = haDefault): TIpHtmlAlign; +procedure TrimFormatting(const S: string; Target: PAnsiChar; PreFormatted: Boolean = False); function dbgs(et: TElementType): string; overload; function GetNextSiblingNode(ANode: TIpHtmlNode): TIpHtmlNode; @@ -2877,11 +2891,11 @@ uses {$IFDEF Html_Print} Printers, PrintersDlgs, IpHtmlPv, {$ENDIF} - ipHtmlBlockLayout, ipHtmlTableLayout; + ipHtmlParser, ipHtmlBlockLayout, ipHtmlTableLayout; {$R *.res} -{$I ipcss.inc} +//{$I ipcss.inc} var FlatSB_GetScrollInfo: function(hWnd: HWND; BarFlag: Integer; @@ -2896,9 +2910,9 @@ var const MaxElements = 1024*1024; - ShyChar = #1; {character used to represent soft-hyphen in strings} - NbspChar = #2; {character used to represent no-break space in strings} - NbspUtf8 = #194#160; {utf8 code of no-break space character} +// ShyChar = #1; {character used to represent soft-hyphen in strings} +// NbspChar = #2; {character used to represent no-break space in strings} +// NbspUtf8 = #194#160; {utf8 code of no-break space character} WheelDelta = 8; const @@ -3168,7 +3182,7 @@ begin end; end; end; -*) + function GetAlignmentForStr(str: string; pDefault: TIpHtmlAlign = haDefault) : TIpHtmlAlign; @@ -3191,7 +3205,7 @@ begin else Result := pDefault; end; end; - +*) {$IFDEF Html_Print} procedure GetRelativeAspect(PrinterDC : hDC); var @@ -3283,7 +3297,7 @@ begin end; end; *) - + (* const CodeCount = 126; {Sorted by Size where size is Length(Name). @@ -3474,7 +3488,7 @@ begin {'Complete boolean eval' must be off} until (Index1 >= CodeCount) or (Codes[Index1].Size > Size1); end; end; - + procedure ExpandEscapes(var S: string); {- returns the string with & escapes expanded} var @@ -3521,7 +3535,7 @@ begin if P <> 0 then ExpandEscapes(Result); end; - +*) function NoBreakToSpace(const S: string): string; var P, n : Integer; @@ -4784,7 +4798,7 @@ begin FHtml := TIpHtmlNodeHtml.Create(nil); FHtml.FOwner := Self; end; - + (* function TIpHtml.NextChar : AnsiChar; begin Result:=#0; @@ -4800,7 +4814,9 @@ begin {write(Result);} end; end; +*) +(* procedure TIpHtml.ReportError(const ErrorMsg: string); begin raise Exception.CreateFmt(SHtmlLineError, [ErrorMsg, LineNumber, LineOffset]); @@ -4822,7 +4838,7 @@ begin break; end; end; - +*) procedure TIpHtml.ReportReferences(Node : TIpHtmlNode); var i : Integer; @@ -4849,9 +4865,11 @@ begin FHasFrames := False; Clear; CharStream := S; + { GlobalPos := 0; LineNumber := 1; LineOffset := 0; + } Parse; ReportReferences(HtmlNode); finally @@ -4860,6 +4878,7 @@ begin end; end; +(* function TIpHtml.GetChar : AnsiChar; var Trimming, @@ -4895,7 +4914,9 @@ begin until Done; LastWasClose := Result = '>'; end; +*) +(* procedure TIpHtml.PutChar(Ch : AnsiChar); begin if (CharSP >= sizeof(CharStack)) then @@ -4903,7 +4924,7 @@ begin CharStack[CharSP] := Ch; Inc(CharSP); end; - +*) function AnsiToEscape(const S: string): string; {- returns the string with & escapes} var @@ -4929,7 +4950,7 @@ begin Dec(i); end; end; - + (* procedure TIpHtml.PutToken(Token : TIpHtmlToken); begin if HaveToken then @@ -4948,7 +4969,7 @@ begin Exit; Result := True; end; - + *) procedure TrimFormatting(const S: string; Target: PAnsiChar; PreFormatted: Boolean = False); var R, W : Integer; @@ -4991,13 +5012,13 @@ begin end; Target[w] := #0; end; - + (* function TIpHtml.GetTokenString: string; begin TokenStringBuf[TBW] := #0; Result := StrPas(TokenStringBuf); end; - + procedure TIpHtml.ClearParmValueArray; var n: TIpHtmlAttributesSet; @@ -5005,7 +5026,8 @@ begin for n:=Low(ParmValueArray) to High(ParmValueArray) do setLength(ParmValueArray[n],0); end; - + *) + (* procedure TIpHtml.ParmValueArrayAdd(const sName, sValue: string); var vFirst, vLast, vPivot: Integer; @@ -5033,7 +5055,9 @@ begin vFirst := Succ(vPivot); end; end; - + *) + + (* function TIpHtml.HtmlTokenListIndexOf(const TokenString: PAnsiChar): integer; var vFirst: Integer; @@ -5066,7 +5090,7 @@ begin vFirst := vPivot + 1; end; end; - + procedure TIpHtml.NextToken; var ParmName : string; @@ -5385,13 +5409,13 @@ begin until (CurToken <> IpHtmlTagText) or not IsWhiteSpace; end; - + procedure TIpHtml.SkipTextTokens; begin while CurToken = IpHtmlTagText do NextToken; end; - + procedure TIpHtml.EnsureClosure(const EndToken : TIpHtmlToken; const EndTokens : TIpHtmlTokenSet); begin @@ -5403,7 +5427,7 @@ begin if FlagErrors then ReportExpectedToken(EndToken); end; - + procedure TIpHtml.ParseTitle(Parent: TIpHtmlNode); var B : PAnsiChar; @@ -5449,7 +5473,7 @@ begin else if FlagErrors then ReportExpectedToken(IpHtmlTagSTYLEend); -end; +end; procedure TIpHtml.ParseScript(Parent : TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); @@ -5463,7 +5487,7 @@ begin or (CurToken in EndTokens); EnsureClosure(IpHtmlTagSCRIPTend, EndTokens); end; - + procedure TIpHtml.ParseNoscript(Parent : TIpHtmlNode); var CurScript : TIpHtmlNodeNOSCRIPT; @@ -5479,19 +5503,19 @@ begin else if FlagErrors then ReportExpectedToken(IpHtmlTagNOSCRIPTend); -end; +end; procedure TIpHtml.ParseIsIndex; begin IndexPhrase := FindAttribute(htmlAttrPROMPT); NextToken; end; - + procedure TIpHtml.ParseBase; begin NextToken; end; - + procedure TIpHtml.ParseMeta; var i,j: Integer; @@ -5522,8 +5546,8 @@ begin Scheme := FindAttribute(htmlAttrSCHEME); end; NextToken; -end; - +end; + procedure TIpHtml.ParseLink(Parent : TIpHtmlNode); begin with TIpHtmlNodeLINK.Create(Parent) do begin @@ -5565,7 +5589,7 @@ begin end; end; end; - + procedure TIpHtml.ParseHead(Parent : TIpHtmlNode); var Lst: TStringListUTF8Fast; @@ -5582,7 +5606,7 @@ begin if Lst.IndexOf(FDocCharset) = 0 then // clear for UTF-8 to avoid conversion FDocCharset := ''; Lst.Free; -end; +end; procedure TIpHtml.ParseFont(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); var @@ -5602,7 +5626,7 @@ begin ParseBodyText(CurFONT, EndTokens + [IpHtmlTagFONTend]); EnsureClosure(IpHtmlTagFONTend, EndTokens); end; - + procedure TIpHtml.ParsePre(ParentNode : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); var CurContainer : TIpHtmlNodePRE; @@ -5615,7 +5639,7 @@ begin Dec(InPre); EnsureClosure(IpHtmlTagPREend, EndTokens); end; - + procedure TIpHtml.ParseText(const EndTokens : TIpHtmlTokenSet; Parent: TIpHtmlNode); var CurContainer : TIpHtmlNodeText; @@ -5635,7 +5659,7 @@ begin NextToken; end; end; -end; +end; procedure TIpHtml.ParseHeader(Parent : TIpHtmlNode; EndToken : TIpHtmlToken; Size : Integer); var @@ -5652,7 +5676,7 @@ begin NextToken else if FlagErrors then ReportExpectedToken(EndToken); -end; +end; procedure TIpHtml.ParseParagraph(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); var @@ -5672,6 +5696,7 @@ begin ReportExpectedToken(IpHtmlTagPend); end; + procedure TIpHtml.ParseAddress(Parent : TIpHtmlNode); var NewPara : TIpHtmlNodeADDRESS; @@ -5716,7 +5741,7 @@ begin end; end; end; - + procedure TIpHtml.ParseUnorderedList(Parent: TIpHtmlNode; EndToken : TIpHtmlToken; const EndTokens: TIpHtmlTokenSet); var @@ -5742,7 +5767,7 @@ begin NewList.ListType); Dec(ListLevel); EnsureClosure(EndToken, EndTokens); -end; +end; procedure TIpHtml.ParseOrderedList(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); @@ -5757,7 +5782,7 @@ begin ParseListItems(NewList, IpHtmlTagOLend, EndTokens + [IpHtmlTagOLend], ulDisc); EnsureClosure(IpHtmlTagOLend, EndTokens); end; - + const TIpHtmlButtonTypeNames : array[TIpHtmlButtonType] of string = ( 'SUBMIT','RESET','BUTTON'); @@ -5780,7 +5805,7 @@ begin ReportError(SHtmlInvType); end; end; - + function TIpHtml.ParseButtonType : TIpHtmlButtonType; var S : string; @@ -5795,7 +5820,7 @@ begin ReportError(SHtmlInvType); end; end; - + procedure TIpHtml.ParseFormFields(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); var CurSelect : TIpHtmlNodeSELECT; @@ -5999,7 +6024,7 @@ begin end; end; end; - + procedure TIpHtml.ParseForm(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); var NewForm : TIpHtmlNodeFORM; @@ -6022,7 +6047,7 @@ begin ParseBodyText(NewForm, EndTokens + [IpHtmlTagFORMend]); EnsureClosure(IpHtmlTagFORMend, EndTokens); end; - + procedure TIpHtml.ParseDefListItems(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); var CurDT : TIpHtmlNodeDT; @@ -6053,7 +6078,7 @@ begin end; end; end; - + procedure TIpHtml.ParseDefinitionList(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); var NewDL : TIpHtmlNodeDL; @@ -6065,7 +6090,7 @@ begin ParseDefListItems(NewDL, EndTokens + [IpHtmlTagDLend]); EnsureClosure(IpHtmlTagDLend, EndTokens); end; - + procedure TIpHtml.ParseDIV(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); var @@ -6080,7 +6105,7 @@ begin ParseBodyText(CurDIV, EndTokens + [IpHtmlTagDIVend]); EnsureClosure(IpHtmlTagDIVend, EndTokens); end; - + procedure TIpHtml.ParseSPAN(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); var CurSPAN : TIpHtmlNodeSPAN; @@ -6095,6 +6120,7 @@ begin EnsureClosure(IpHtmlTagSPANend, EndTokens); end; + procedure TIpHtml.ParseCENTER(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); var CurContainer : TIpHtmlNodeDIV; @@ -6140,7 +6166,7 @@ begin ParseBodyText(CurBlink, EndTokens + [IpHtmlTagBLINKend]); EnsureClosure(IpHtmlTagBLINKend, EndTokens); end; - + procedure TIpHtml.ParseBLOCKQUOTE(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); var BQ : TIpHtmlNodeBLOCKQUOTE; @@ -6151,7 +6177,7 @@ begin ParseBodyText(BQ, EndTokens + [IpHtmlTagBLOCKQUOTEend]); EnsureClosure(IpHtmlTagBLOCKQUOTEend, EndTokens); end; - + procedure TIpHtml.ParseQ(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); var BQ : TIpHtmlNodeQ; @@ -6161,7 +6187,7 @@ begin NextToken; ParseBodyText(BQ, EndTokens + [IpHtmlTagQend]); EnsureClosure(IpHtmlTagQend, EndTokens); -end; +end; procedure TIpHtml.ParseINS(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); var @@ -6188,7 +6214,7 @@ begin ParseBodyText(BQ, EndTokens + [IpHtmlTagDELend]); EnsureClosure(IpHtmlTagDELend, EndTokens); end; - + procedure TIpHtml.ParseFontStyle(Parent : TIpHtmlNode; StartToken : TIpHtmlToken; const EndTokens : TIpHtmlTokenSet); var @@ -6221,7 +6247,7 @@ begin NextToken; ParseBodyText(CurStyle, EndTokens); EnsureClosure(succ(StartToken), EndTokens); -end; +end; procedure TIpHtml.ParseHR(Parent : TIpHtmlNode); var @@ -6240,7 +6266,7 @@ begin end; NextToken; end; - + procedure TIpHtml.ParseBR(Parent : TIpHtmlNode); var BR : TIpHtmlNodeBR; @@ -6253,7 +6279,7 @@ begin BR.Style :=FindAttribute(htmlAttrSTYLE); NextToken; end; - + procedure TIpHtml.ParseNOBR(Parent : TIpHtmlNode); begin NextToken; @@ -6263,7 +6289,7 @@ begin else if FlagErrors then ReportExpectedToken(IpHtmlTagNOBRend); -end; +end; procedure TIpHtml.ParsePhraseElement(Parent : TIpHtmlNode; StartToken, EndToken : TIpHtmlToken; const EndTokens: TIpHtmlTokenSet); @@ -6304,7 +6330,7 @@ begin if FlagErrors then ReportExpectedToken(EndToken); end; - + procedure TIpHtml.ParseAnchor(Parent : TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); var CurAnchor : TIpHtmlNodeA; @@ -6361,7 +6387,8 @@ begin Name := FindAttribute(htmlAttrNAME); end; NextToken; -end; +end; + procedure TIpHtml.ParseApplet(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); var @@ -6457,7 +6484,7 @@ begin if FlagErrors then ReportExpectedToken(IpHtmlTagOBJECTend); end; - + procedure TIpHtml.ParseTableRow(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); var CurHeader : TIpHtmlNodeTH; @@ -6671,7 +6698,7 @@ begin NextToken; end; end; - + procedure TIpHtml.ParseTABLE(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); var CurTable : TIpHtmlNodeTABLE; @@ -6728,7 +6755,7 @@ begin SkipTextTokens; EnsureClosure(IpHtmlTagTABLEend, EndTokens); end; - + procedure TIpHtml.ParseMAP(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); var CurMap : TIpHtmlNodeMAP; @@ -6762,7 +6789,7 @@ begin end; EnsureClosure(IpHtmlTagMAPend, EndTokens); end; - + procedure TIpHtml.ParseBasefont(Parent : TIpHtmlNode); var CurBasefont : TIpHtmlNodeBASEFONT; @@ -6772,7 +6799,7 @@ begin CurBasefont.Size := ParseInteger(htmlAttrSIZE, 3); NextToken; end; - + procedure TIpHtml.ParseInline(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); begin case CurToken of @@ -6828,7 +6855,7 @@ begin NextToken; end; end; - + procedure TIpHtml.ParseBlock(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); begin case CurToken of @@ -6861,7 +6888,7 @@ begin NextToken; end; end; - + procedure TIpHtml.ParseStyleSheet(Parent: TIpHtmlNode; HRef: String); var StyleStream: TStream; @@ -6885,7 +6912,7 @@ begin StyleStream.Free; end; end; - + procedure TIpHtml.ParseBodyText(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); begin Inc(InBlock); @@ -6934,12 +6961,15 @@ begin Dec(InBlock); end; end; - + *) function TIpHtml.FindAttribute(const AttrNameSet : TIpHtmlAttributesSet) : string; begin - Result := ParmValueArray[AttrNameSet]; + if FParser <> nil then + Result := FParser.FindAttribute(AttrNameSet) + else + Result := ''; end; - + (* function TIpHtml.ParseInteger(const AttrNameSet: TIpHtmlAttributesSet; aDefault : Integer): Integer; var S : string; @@ -6968,7 +6998,7 @@ function TIpHtml.ParseHtmlInteger2(const AttrNameSet: TIpHtmlAttributesSet; begin Result := TIpHtmlInteger.Create(ParseInteger(AttrNameSet, aDefault)); end; - + function TIpHtml.ParseRelSize{(const Default : string)} : TIpHtmlRelSize; var S : string; @@ -6995,6 +7025,7 @@ begin ReportError(SHtmlInvInt); end; + function TIpHtml.ParsePixels(const AttrNameSet: TIpHtmlAttributesSet; const aDefault: string): TIpHtmlPixels; var @@ -7018,7 +7049,7 @@ begin end; end; end; - + * function TIpHtml.ParseHyperLength(const AttrNameSet: TIpHtmlAttributesSet; const aDefault: string): TIpHtmlLength; var @@ -7048,7 +7079,7 @@ begin and (Result.LengthValue > 100) then Result.LengthValue := 100; end; - + function TIpHtml.ParseHyperMultiLength(const AttrNameSet: TIpHtmlAttributesSet; const aDefault: string): TIpHtmlMultiLength; var @@ -7081,7 +7112,7 @@ begin Result.LengthType := hmlUndefined; end; end; - + function TIpHtml.ParseHyperMultiLengthList(const AttrNameSet: TIpHtmlAttributesSet; const aDefault: string): TIpHtmlMultiLengthList; var @@ -7130,7 +7161,7 @@ begin B := E + 1; end; end; - + *) function CalcMultiLength(const List: TIpHtmlMultiLengthList; Avail: Integer; var Sections: Integer): TIntArr; var @@ -7202,12 +7233,13 @@ begin end; until S = 0; end; - + (* function TIpHtml.ParseBoolean(const AttrNameSet: TIpHtmlAttributesSet): Boolean; begin Result := length(ParmValueArray[AttrNameSet]) > 0; end; + const TIpHtmlOLStyleNames : array[TIpHtmlOLStyle] of char = ( '1', 'a', 'A', 'i', 'I'); @@ -7226,7 +7258,7 @@ begin ReportError(SHtmlInvType); end; end; - + function TIpHtml.ParseULStyle(Default : TIpHtmlULType) : TIpHtmlULType; var S : string; @@ -7242,14 +7274,14 @@ begin if FlagErrors then ReportError(SHtmlInvType); end; -end; +end; function TIpHtml.ParseAlignment : TIpHtmlAlign; begin Result := GetAlignmentForStr(FindAttribute(htmlAttrALIGN), haDefault); //haLeft); // if FlagErrors then // ReportError(SHtmlInvAlign); -end; +end; function TIpHtml.ParseVAlignment : TIpHtmlVAlign; var @@ -7286,6 +7318,7 @@ begin end; end; + const TIpHtmlImageAlignNames : array[TIpHtmlImageAlign] of string = ( 'TOP', 'MIDDLE', 'BOTTOM', 'LEFT', 'RIGHT', 'CENTER'); @@ -7319,7 +7352,7 @@ begin ReportError(SHtmlInvValType); end; end; - + function TIpHtml.ParseShape : TIpHtmlMapShape; var S : string; @@ -7371,7 +7404,7 @@ begin ReportError(SHtmlInvAlign); end; end; - + function TIpHtml.ParseDir : TIpHtmlDirection; var S : string; @@ -7386,7 +7419,7 @@ begin if FlagErrors then ReportError(SHtmlInvDir); end; - + function TIpHtml.ColorFromString(S : string) : TColor; var R, G, B, Err : Integer; @@ -7452,7 +7485,7 @@ begin ParseBaseProps(Self); end; NextToken; -end; +end; procedure TIpHtml.ParseIFrame(Parent : TIpHtmlNode); var @@ -7479,7 +7512,7 @@ begin if CurToken = IpHtmlTagIFRAMEend then NextToken; end; - + procedure TIpHtml.ParseNOFRAMES(Parent : TIpHtmlNode); var CurNoFrames : TIpHtmlNodeNOFRAMES; @@ -7490,7 +7523,7 @@ begin if CurToken = IpHtmlTagNOFRAMESend then NextToken; end; - + procedure TIpHtml.ParseFrameSet(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); begin @@ -7568,7 +7601,7 @@ begin NextToken; end; end; - + procedure TIpHtml.ParseHtml; begin {lead token is optional} @@ -7589,7 +7622,49 @@ begin ParseBody(HtmlNode, [IpHtmlTagEof]); {may not be present} end; end; - + *) + +procedure TIpHtml.FixMissingBodyTag; +var + i: Integer; + node: TIpHtmlNode; +begin + { Does the HTML include a body node? } + if not FHtml.HasBodyNode then + { No. Create a body node under FHtml. } + with FHtml do + begin + with TIpHtmlNodeBODY.Create(FHtml) do + LoadAndApplyCSSProps; + { Make each of FHtml's current children the children of the Body node. } + for i := Pred(ChildCount) downto 0 do + begin + node := ChildNode[i]; + if node <> Body then + begin + FChildren.Remove(node); + node.FParentNode := Body; + Body.FChildren.Insert(0, node); + end; + end; + end; +end; + +procedure TIpHtml.Parse; +begin + FParser := TIpHtmlParser.Create(Self, CharStream); + try + if FParser.Execute then begin + FTitleNode := TIpHtmlParser(FParser).TitleNode; + FCurFrameSet := TIpHtmlParser(FParser).FrameSet; + FDocCharSet := TIpHtmlParser(FParser).DocCharSet; + FHasFrames := TIpHtmlParser(FParser).HasFrames; + end; + finally + FreeAndNil(FParser); + end; +end; + (* procedure TIpHtml.Parse; var ch1,ch2,ch3: AnsiChar; @@ -7649,7 +7724,7 @@ begin end; end; end; - +*) constructor TIpHtml.Create; var TmpBitmap: TGraphic; @@ -7799,7 +7874,7 @@ begin PropBCache.Free; inherited; end; - + (* function TIpHtml.ParseFrameProp(Default : TIpHtmlFrameProp): TIpHtmlFrameProp; var S : string; @@ -7827,7 +7902,7 @@ begin ReportError(SHtmlInvFrame); end; end; - + function TIpHtml.ParseRules(Default : TIpHtmlRules): TIpHtmlRules; var S : string; @@ -7849,14 +7924,14 @@ begin if FlagErrors then ReportError(SHtmlInvRule); end; -end; +end; function TIpHtml.ParseCellAlign(Default : TIpHtmlAlign): TIpHtmlAlign; begin Result := GetAlignmentForStr(FindAttribute(htmlAttrALIGN), Default); // if FlagErrors then // ReportError(SHtmlInvAlign); -end; +end; function TIpHtml.ParseFrameScrollingProp: TIpHtmlFrameScrolling; var @@ -7873,7 +7948,7 @@ begin if FlagErrors then ReportError(SHtmlInvScroll); end; -end; +end; function TIpHtml.ParseVAlignment3: TIpHtmlVAlign3; var @@ -7896,6 +7971,7 @@ begin ReportError(SHtmlInvAlign); end; end; +*) procedure TIpHtml.SetDefaultProps; begin @@ -8577,7 +8653,7 @@ begin if FDataProvider <> nil then Result := FDataProvider.BuildURL(FCurURL,Ext) else - Result := BuildURL(FCurURL, Ext); + Result := BuildURL(FCurURL, Ext); end; function TIpHtml.NewElement(EType : TElementType; Own: TIpHtmlNode) : PIpHtmlElement; @@ -9062,7 +9138,7 @@ end; function FindInnerBlock(Node : TIpHTMLNode): TIpHtmlNodeBlock; begin - while not (Node is TIpHtmlNodeBlock) do + while (Node <> nil) and not (Node is TIpHtmlNodeBlock) do Node := Node.FParentNode; Result := TIpHtmlNodeBlock(Node); end; @@ -9078,6 +9154,8 @@ var begin FEscapedText := Value; Block := FindInnerBlock(Self); + if Block = nil then + exit; {we need to clear the queue so that it will be built again} Block.FLayouter.ClearWordList; @@ -12405,7 +12483,7 @@ begin begin if InlineCSS = nil then InlineCSS := TCSSProps.Create; - Commands := SeperateCommands(Style); + Commands := SeparateCommands(Style); InlineCSS.ReadCommands(Commands); Commands.Free; end; @@ -12608,11 +12686,6 @@ begin end; end; -function TIpHtmlNodeCore.ElementName: String; -begin - Result := FElementName; -end; - function TIpHtmlNodeCore.GetAlign: TIpHtmlAlign; begin Result := Props.Alignment; diff --git a/components/turbopower_ipro/iphtmlblocklayout.pas b/components/turbopower_ipro/iphtmlblocklayout.pas index a838402db4..e3f7eaadb9 100644 --- a/components/turbopower_ipro/iphtmlblocklayout.pas +++ b/components/turbopower_ipro/iphtmlblocklayout.pas @@ -7,7 +7,7 @@ interface uses types, Classes, SysUtils, LCLPRoc, LCLIntf, Graphics, - IpUtils, IpHtml, iphtmlprop; + IpUtils, IpHtml, IpHtmlProp, IpHtmlUtils; type diff --git a/components/turbopower_ipro/iphtmlparser.pas b/components/turbopower_ipro/iphtmlparser.pas new file mode 100644 index 0000000000..8e7af394eb --- /dev/null +++ b/components/turbopower_ipro/iphtmlparser.pas @@ -0,0 +1,3060 @@ +unit IpHtmlParser; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Graphics, + ipConst, ipUtils, ipHtmlUtils, ipHtmlProp, ipHtml, ipCSS; + +type + TIpHtmlParser = class(TIpHtmlBasicParser) + private +// FBody: TIpHtmlNodeBODY; + FCharSP: Integer; + FCharStack: array [0..7] of AnsiChar; + FCharStream: TStream; +// FCSS: TCSSGlobalProps; + FCurFrameSet: TIpHtmlNodeFRAMESET; + FCurToken: TIpHtmlToken; + FCurURL: string; + FDocCharSet: String; + FGlobalPos: Integer; + FHasBOM: Boolean; + FHasFrames: Boolean; + FHaveToken: Boolean; +// FHtml: TIpHtmlNodeHtml; + FInBlock: Integer; + FIndexPhrase: string; + FInPre: Integer; + FLastWasClose: Boolean; + FLastWasSpace: Boolean; + FLineNumber: Integer; + FLineOffset: Integer; + FListLevel: Integer; + FOwner: TIpHtml; + FParmBuf: PChar; + FParmBufSize: Integer; + FParmValueArray: TParmValueArray; +// FStartPos: Integer; + FTitleNode : TIpHtmlNodeTITLE; + FTokenBuffer: TIpHtmlToken; + FTokenStringBuf: PChar; {array[16383] of AnsiChar;} + TBW: Integer; + + function GetFlagErrors: Boolean; + + procedure ClearParmValueArray; + procedure ParmValueArrayAdd(const sName, sValue: string); + + procedure ReportError(const AErrorMsg: string); + procedure ReportExpectedError(const AErrorMsg: string); + procedure ReportExpectedToken(const AToken: TIpHtmlToken); + + protected + function ColorFromString(S: string): TColor; + procedure EnsureClosure(const EndToken: TIpHtmlToken; const EndTokens: TIpHtmlTokenSet); + function GetChar: AnsiChar; + function GetTokenString: string; + function HtmlTokenListIndexOf(const TokenString: PAnsiChar): integer; + function IsWhiteSpace: Boolean; + function NextChar: AnsiChar; + procedure NextNonBlankToken; + procedure NextRealToken; + procedure NextToken; + procedure PutChar(Ch: AnsiChar); + procedure PutToken(AToken: TIpHtmlToken); + procedure SkipTextTokens; + + protected + // parser helper routines + function ParseAlignment: TIpHtmlAlign; + function ParseBoolean(const AttrNameSet: TIpHtmlAttributesSet): Boolean; + function ParseBRClear: TIpHtmlBreakClear; + function ParseButtonType: TIpHtmlButtonType; + function ParseCellAlign(ADefault: TIpHtmlAlign): TIpHtmlAlign; + procedure ParseCenter(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + function ParseDir: TIpHtmlDirection; + function ParseFrameProp(ADefault: TIpHtmlFrameProp): TIpHtmlFrameProp; + function ParseFrameScrollingProp: TIpHtmlFrameScrolling; + function ParseHtmlInteger2(const AttrNameSet: TIpHtmlAttributesSet; + ADefault: Integer): TIpHtmlInteger; + function ParseHyperLength(const AttrNameSet: TIpHtmlAttributesSet; + const ADefault: string): TIpHtmlLength; + function ParseHyperMultiLength(const AttrNameSet: TIpHtmlAttributesSet; + const ADefault: string): TIpHtmlMultiLength; + function ParseHyperMultiLengthList(const AttrNameSet: TIpHtmlAttributesSet; + const ADefault: string): TIpHtmlMultiLengthList; + procedure ParseIFrame(AParent: TIpHtmlNode); + function ParseImageAlignment(ADefault: TIpHtmlImageAlign): TIpHtmlImageAlign; + procedure ParseImg(AParent: TIpHtmlNode); + function ParseInputType: TIpHtmlInputType; + function ParseInteger(const AttrNameSet: TIpHtmlAttributesSet; + ADefault: Integer): Integer; + function ParseMethod: TIpHtmlFormMethod; + function ParseObjectValueType: TIpHtmlObjectValueType; + function ParseOLStyle(ADefault: TIpHtmlOLStyle): TIpHtmlOLStyle; + function ParsePixels(const AttrNameSet: TIpHtmlAttributesSet; + const ADefault: string): TIpHtmlPixels; + function ParseRelSize: TIpHtmlRelSize; + function ParseRules(ADefault: TIpHtmlRules): TIpHtmlRules; + function ParseShape: TIpHtmlMapShape; + function ParseULStyle(ADefault: TIpHtmlULType): TIpHtmlULType; + function ParseVAlignment: TIpHtmlVAlign; + function ParseVAlignment2: TIpHtmlVAlignment2; + function ParseVAlignment3: TIpHtmlVAlign3; + + protected + // Methods for parsing html nodes + procedure ParseAddress(AParent: TIpHtmlNode); + procedure ParseAnchor(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseApplet(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseBase; + procedure ParseBaseFont(AParent: TIpHtmlNode); + procedure ParseBlink(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseBlock(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseBlockQuote(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseBody(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseBodyText(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseBR(AParent: TIpHtmlNode); + procedure ParseColGroup(AParent: TIpHtmlNode); + procedure ParseDefinitionList(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseDefinitionListItems(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseDel(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseDIV(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseFont(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseFontStyle(AParent: TIpHtmlNode; StartToken: TIpHtmlToken; + const EndTokens: TIpHtmlTokenSet); + procedure ParseForm(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseFormFields(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseFrame(AParent: TIpHtmlNode); + procedure ParseFrameSet(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseHead(AParent: TIpHtmlNode); + procedure ParseHeader(AParent: TIpHtmlNode; EndToken: TIpHtmlToken; ASize: Integer); + procedure ParseHeadItems(AParent: TIpHtmlNode); + procedure ParseHR(AParent: TIpHtmlNode); + procedure ParseHtml; + procedure ParseInline(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseIns(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseIsIndex; + procedure ParseLeft(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseLink(AParent: TIpHtmlNode); + procedure ParseListItems(AParent: TIpHtmlNodeCore; EndToken: TIpHtmlToken; + const EndTokens: TIpHtmlTokenSet; ADefaultListStyle: TIpHtmlULType); + procedure ParseMap(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseMeta(AParent: TIpHtmlNode); + procedure ParseNOBR(AParent: TIpHtmlNode); + procedure ParseNoFrames(AParent: TIpHtmlNode); + procedure ParseNoScript(AParent: TIpHtmlNode); + procedure ParseObject(AParent: TIpHtmlNode); + procedure ParseOrderedList(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseParagraph(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParsePhraseElement(AParent: TIpHtmlNode; StartToken, EndToken: TIpHtmlToken; + const EndTokens: TIpHtmlTokenSet); + procedure ParsePre(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseQ(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseRight(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseScript(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseSpan(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseStyle(AParent: TIpHtmlNode); + procedure ParseStyleSheet(AParent: TIpHtmlNode; HRef: String); + procedure ParseTable(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseTableBody(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseTableRow(AParent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet); + procedure ParseTableRows(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseText(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); + procedure ParseTitle(AParent: TIpHtmlNode); + procedure ParseUnorderedList(AParent: TIpHtmlNode; EndToken: TIpHtmlToken; const EndTokens: TIpHtmlTokenSet); + + property FlagErrors: Boolean read GetFlagErrors; + + public + constructor Create(AOwner: TIpHtml; AStream: TStream); + function Execute: Boolean; override; + function FindAttribute(const AttrNameSet: TIpHtmlAttributesSet): string; override; + + property DocCharset: String read FDocCharset; + property FrameSet: TIpHtmlNodeFRAMESET read FCurFrameSet; + property HasFrames: Boolean read FHasFrames; + property TitleNode: TIpHtmlNodeTITLE read FTitleNode; + property ParmValueArray: TParmValueArray read FParmValueArray; + end; + +implementation + +uses + LConvEncoding, LazUTF8, LazStringUtils, Translations; + +{ TIpHtmlParser } + +constructor TIpHtmlParser.Create(AOwner: TIpHtml; AStream: TStream); +begin + inherited Create; + FCharStream := AStream; + FOwner := AOwner; +end; + +procedure TIpHtmlParser.ClearParmValueArray; +var + n: TIpHtmlAttributesSet; +begin + for n := Low(FParmValueArray) to High(FParmValueArray) do + FParmValueArray[n] := ''; +// SetLength(FParmValueArray[n], 0); +end; + +function TIpHtmlParser.ColorFromString(S: String): TColor; +var + err: String; +begin + if TryColorFromString(S, Result, err) then + // + else + begin + ReportError(err); + Result := clNone; + end; +end; + +procedure TIpHtmlParser.EnsureClosure(const EndToken: TIpHtmlToken; + const EndTokens: TIpHtmlTokenSet); +begin + if FCurToken = EndToken then + NextToken + else + if FCurToken in EndTokens then + else + if FlagErrors then + ReportExpectedToken(EndToken); +end; + +function TIpHtmlParser.Execute: Boolean; +var + ch1, ch2, ch3: AnsiChar; + startPos: Int64; +begin + Result := false; + + Getmem(FTokenStringBuf, FCharStream.Size * 4 + 65536); + try + FGlobalPos := 0; + FLineNumber := 1; + FLineOffset := 0; + FCharSP := 0; + FListLevel := 0; + FDocCharset := ''; + FHasBOM := false; + FHasFrames := false; + startPos := FCharStream.Position; + ch1 := GetChar; + ch2 := GetChar; + if (ch1 = #$FE) and (ch2 = #$FF) then begin + FDocCharset := 'UCS-2BE'; + raise Exception.CreateFmt('%s document encoding not supported!', [FDocCharset]); + end else + if (ch1 = #$FF) and (ch2 = #$FE) then begin + FDocCharset := 'UCS-2LE'; + raise Exception.CreateFmt('%s document encoding not supported!', [FDocCharset]); + end else + if (ch1 = #$EF) and (ch2=#$BB) then begin + ch3 := GetChar; + if ch3 = #$BF then begin + FDocCharset := 'UTF-8'; + FHasBOM := true; + end else begin + PutChar(ch3); + PutChar(ch2); + PutChar(ch1); + end; + end else begin + PutChar(ch2); + PutChar(ch1); + end; + + repeat + NextToken; + until FCurToken in [IpHtmlTagHtml, IpHtmlTagFRAMESET, IpHtmlTagEOF]; + + if FCurToken = IpHtmlTagEOF then begin + FCharStream.Position := startPos; + FCharSP := 0; + FListLevel := 0; + repeat + NextToken; + until FCurToken <> IpHtmlTagText; + end; + if FCurToken = IpHtmlTagEOF then Exit; + ParseHtml; + Result := true; + finally + FreeMem(FTokenStringBuf); + FTokenStringBuf := nil; + if FParmBuf <> nil then begin + FreeMem(FParmBuf); + FParmBuf := nil; + FParmBufSize := 0; + end; + end; +end; + +function TIpHtmlParser.FindAttribute(const AttrNameSet: TIpHtmlAttributesSet): string; +begin + Result := FParmValueArray[AttrNameSet]; +end; + +function TIpHtmlParser.GetChar: AnsiChar; +var + trimming, done: Boolean; +begin + trimming := False; + repeat + done := True; + if (FCharSP > 0) then begin + Dec(FCharSP); + Result := FCharStack[FCharSP]; + end else begin + Result := NextChar; + end; + if (FInPre = 0) and (FCurToken <> IpHtmlTagPRE) then begin + if (Result <= ' ') and (Result > #0) then begin + if (Result < ' ') and FLastWasClose then begin + done := False; + trimming := True; + end else + if trimming then + done := False + else + if FLastWasSpace then + Done := False + else begin + Result := ' '; + FLastWasSpace := True; + end; + end else + FLastWasSpace := False; + end; + until done; + FLastWasClose := (Result = '>'); +end; + +function TIpHtmlParser.GetFlagErrors: Boolean; +begin + Result := FOwner.FlagErrors; +end; + +function TIpHtmlParser.GetTokenString: string; +begin + FTokenStringBuf[TBW] := #0; + Result := StrPas(FTokenStringBuf); +end; + +function TIpHtmlParser.HtmlTokenListIndexOf(const TokenString: PAnsiChar): integer; +var + vFirst: Integer; + vLast: Integer; + vPivot: Integer; + vicmp: integer; +begin + vFirst := Low(IpHtmlTokens); //Sets the first item of the range + vLast := High(IpHtmlTokens); //Sets the last item of the range + Result := -1; //Initializes the Found flag (Not found yet) + + //If First > Last then the searched item doesn't exist + //If the item is found the loop will stop + while (vFirst <= vLast) do + begin + //Gets the middle of the selected range + vPivot := (vFirst + vLast) div 2; + //Compares the String in the middle with the searched one + vicmp := strcomp(IpHtmlTokens[vPivot].pc, TokenString); + if vicmp = 0 then + begin + Result := vPivot; + exit; + end + //If the Item in the middle has a bigger value than + //the searched item, then select the first half + else if vicmp > 0 then + vLast := vPivot - 1 //else select the second half + else + vFirst := vPivot + 1; + end; +end; + +function TIpHtmlParser.IsWhiteSpace: Boolean; +var + i : Integer; +begin + Result := False; + for i := 0 to TBW - 1 do + if FTokenStringBuf[i] > ' ' then + Exit; + Result := True; +end; + +function TIpHtmlParser.NextChar: AnsiChar; +begin + Result := #0; + if FCharStream.Read(Result, 1) = 0 then + Result := #0 + else begin + Inc(FGlobalPos); + if Result = #10 then begin + Inc(FLineNumber); + FLineOffset := 0; + end else + Inc(FLineOffset); + end; +end; + +procedure TIpHtmlParser.NextNonBlankToken; +begin + repeat + NextToken; + until (FCurToken <> IpHtmlTagText) or not IsWhiteSpace; +end; + +procedure TIpHtmlParser.NextRealToken; +begin + repeat + NextToken; + until FCurToken <> IpHtmlTagText; +end; + +procedure TIpHtmlParser.NextToken; +var + parmName: string; + PBW: Integer; + i: Integer; + inValue, inQuote, inAttr: Boolean; + seenEqual, seenQuotes: Boolean; + ctl, done, endFound: Boolean; + quoteChar: AnsiChar; + ch: AnsiChar; + + procedure AddParmChar(const Ch: AnsiChar); + begin + if PBW >= FParmBufSize - 1 then begin + Inc(FParmBufSize, 4096); + ReallocMem(FParmBuf, FParmBufSize); + end; + FParmBuf[PBW] := Ch; + Inc(PBW); + end; + + function ParmString: string; + begin + if PBW = 0 then + Result := '' + else begin + FParmBuf[PBW] := #0; + Result := StrPas(FParmBuf); + PBW := 0; + end; + end; + + procedure AddTokenChar(const Ch: AnsiChar); + begin + FTokenStringBuf[TBW] := Ch; + Inc(TBW); + end; + +begin + if FHaveToken then begin + FCurToken := FTokenBuffer; + FHaveToken := False; + Exit; + end; + quoteChar := ' '; + repeat + TBW := 0; + PBW := 0; + ClearParmValueArray; + ch := GetChar; + if ch = #0 then begin + FCurToken := IpHtmlTagEof; + Exit; + end; + if ch = '<' then begin + ch := GetChar; + if ch = '!' then begin + if GetChar = '-' then begin + if GetChar <> '-' then + if FlagErrors then + ReportError(SHtmlDashExp); + ch := GetChar; + repeat + while ch <> '-' do begin + if ch = #0 then + break; + ch := GetChar; + end; + if (ch = #0) then + break + else begin + ch := GetChar; + if ch = #0 then + break; + if ch = '-' then begin + ch := GetChar; + while (ch = '-') do + ch := GetChar; + while not (ch in [#0, '>']) do + ch := GetChar; + break; + end; + end; + until false; + FCurToken := IpHtmlTagComment; + end else begin + ch := GetChar; + while ch <> '>' do + ch := GetChar; + FCurToken := IpHtmlTagComment; + end; + end else begin + while ch <> '>' do begin + if ch <= ' ' then begin + ch := ' '; + break; + end; + if ch in [#33..#255] then + AddTokenChar(UpCase(ch)); + ch := GetChar; + end; + if ch = ' ' then begin + ch := GetChar; + {list :== [attr]* ">"} + {attr :== [" "]* attr-name [attr-value]} + {attr-value :== [" "]* "=" [" "]* value} + {value :== ['"']* string ['"']*} + inAttr := False; + inValue := False; + inQuote := False; + seenEqual := False; + seenQuotes := False; + parmName := ''; + PBW := 0; + while True do begin + case ch of + #0 : break; + #1..#31 : + if inAttr then begin + inAttr := False; + parmName := ParmString; + seenEqual := False; + end else + if inValue then begin + if parmName <> '' then begin + ParmValueArrayAdd(UpperCase(parmName), ParmString); + parmName := ''; + end; + inValue := False; + seenEqual := False; + seenQuotes := False; + end; + ' ', '/' : + if inQuote then + AddParmChar(ch) + else + if inAttr then begin + inAttr := False; + parmName := ParmString; + seenEqual := False; + end else + if inValue then begin + if parmName <> '' then begin + ParmValueArrayAdd(UpperCase(parmName), ParmString); + parmName := ''; + end; + inValue := False; + seenEqual := False; + seenQuotes := False; + end; + '''' : + if inQuote then + begin + if quoteChar = '''' then + inQuote := False + else + AddParmChar(''''); + end else + begin + inQuote := True; + seenQuotes := True; + quoteChar := ''''; + end; + '"' : + if inQuote then + begin + if quoteChar = '"' then + inQuote := False + else + AddParmChar('"') + end else + begin + inQuote := True; + seenQuotes := True; + quoteChar := '"'; + end; + '<', '>' : + begin + if inQuote then + AddParmChar(ch) + else begin + if inValue then begin + if parmName <> '' then begin + ParmValueArrayAdd(UpperCase(parmName), ParmString); + parmName := ''; + end; + end; + break; + end; + end; + '=' : + begin + seenEqual := True; + if inAttr then begin + parmName := ParmString; + inAttr := False; + end else + if inValue then + AddParmChar(ch) + end; + else + if inAttr or inValue then + AddParmChar(ch) + else + if seenEqual and (inQuote or not seenQuotes) then begin + inValue := True; + AddParmChar(ch); + end else begin + if (parmName <> '') and not seenQuotes then begin + parmName := UpperCase(parmName); + ParmValueArrayAdd(parmName, parmName); + end; + parmName := ''; + AddParmChar(ch); + seenEqual := False; + seenQuotes := False; + inValue := False; + inAttr := True; + end; + end; + ch := GetChar; + end; + + if inAttr then begin + parmName := UpperCase(ParmString); + if (parmName <> '') then begin + ParmValueArrayAdd(parmName, parmName); + end; + end; + end; + + { Check if this is a token of the form } + if (TBW > 0) and (FTokenStringBuf[TBW - 1] = '/') then begin + {It is, set EndFound flag and convert to normal open token} + endFound := True; + Dec(TBW); + end else + endFound := False; + FTokenStringBuf[TBW] := #0; + FCurToken := IpHtmlTagUnknown; + i := HtmlTokenListIndexOf(FTokenStringBuf); + if i <> -1 then + FCurToken := IpHtmlTokens[i].tk; + + {If the token was a single terminated token ( + as opposed to normal a sequence), we fake + it by pushing a close token to match the open token + which was mangled above where EndFound was set.} + + if (FCurToken <> IpHtmlTagUnknown) and endFound then + if succ(FCurToken) in IpEndTokenSet then + PutToken(succ(FCurToken)); + end; + end else begin + FCurToken := IpHtmlTagText; + repeat + done := True; + ctl := False; + while ch <> '<' do begin + case ch of + #0 : + break; + #10, #13 : + begin + ctl := True; + if FInPre > 0 then + AddTokenChar(ch); + end + else + AddTokenChar(ch); + end; + ch := GetChar; + end; + + if ch <> #0 then begin + ch := GetChar; + while (ch > #0) and (ch < ' ') do + ch := GetChar; + case ch of + '/', '!', 'a'..'z','A'..'Z' : + begin + PutChar(ch); + PutChar('<'); + end + else + begin + AddTokenChar('<'); + AddTokenChar(Ch); + done := False; + ch := GetChar; + end; + end; + end; + + if (FInPre = 0) and ctl and IsWhiteSpace then + FCurToken := IpHtmlTagCOMMENT; + until Done; + end; + + // Eat script blocks that could confuse the parsing + // example www.sqlite.org has javascript to write dynamic + // content inside a table + if FCurToken = IpHtmlTagSCRIPT then + ParseScript(FOwner.HtmlNode, []); + until + (FCurToken <> IpHtmlTagCOMMENT) and + ((FCurToken <> IpHtmlTagText) or (FInBlock > 0) or (FInPre > 0) or not IsWhiteSpace); +end; + +procedure TIpHtmlParser.ParmValueArrayAdd(const sName, sValue: string); +var + vFirst, vLast, vPivot: Integer; +begin + vFirst := Ord(Low(TIpHtmlAttributesSet)); //Sets the first item of the range + vLast := Ord(High(TIpHtmlAttributesSet)); //Sets the last item of the range + + //If First > Last then the searched item doesn't exist + //If the item is found the loop will stop + while (vFirst <= vLast) do + begin + //Gets the middle of the selected range + vPivot := (vFirst + vLast) div 2; + //Compares the String in the middle with the searched one + if TIpHtmlAttributesNames[TIpHtmlAttributesSet(vPivot)] = sName then + begin + FParmValueArray[TIpHtmlAttributesSet(vPivot)] := sValue; + Exit; + end + //If the Item in the middle has a bigger value than + //the searched item, then select the first half + else if TIpHtmlAttributesNames[TIpHtmlAttributesSet(vPivot)] > sName then + vLast := Pred(vPivot)//else select the second half + else + vFirst := Succ(vPivot); + end; +end; + +procedure TIpHtmlParser.ParseAddress(AParent: TIpHtmlNode); +var + newPara: TIpHtmlNodeADDRESS; +begin + newPara := TIpHtmlNodeADDRESS.Create(AParent); + newPara.ParseBaseProps(FOwner); + NextToken; + ParseBodyText(newPara, [IpHtmlTagADDRESSend]); + if FCurToken = IpHtmlTagADDRESSend then + NextToken + else + if FlagErrors then + ReportExpectedToken(IpHtmlTagADDRESSend); +end; + +function TIpHtmlParser.ParseAlignment: TIpHtmlAlign; +begin + Result := GetAlignmentForStr(FindAttribute(htmlAttrALIGN), haDefault); +end; + +procedure TIpHtmlParser.ParseAnchor(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + curAnchor: TIpHtmlNodeA; +begin + curAnchor := TIpHtmlNodeA.Create(AParent); + FOwner.TabList.Add(curAnchor); + with curAnchor do begin + Name := FindAttribute(htmlAttrNAME); + HRef := FindAttribute(htmlAttrHREF); + Rel := FindAttribute(htmlAttrREL); + Rev := FindAttribute(htmlAttrREV); + Title := FindAttribute(htmlAttrTITLE); + ParseBaseProps(FOwner); + Shape := ParseShape; + TabIndex := ParseInteger(htmlAttrTABINDEX, -1); + Target := FindAttribute(htmlAttrTARGET); + end; + NextToken; + ParseBodyText(curAnchor, EndTokens + [IpHtmlTagAend] - [IpHtmlTagA]); + if FCurToken = IpHtmlTagAend then + NextToken + else + if FCurToken = IpHtmlTagA then + else + if FCurToken in EndTokens then + else + if FlagErrors then + ReportExpectedToken(IpHtmlTagAend); + if (curAnchor.ChildCount = 0) and (CurAnchor.Name <> '') then + TIpHtmlNodeText.Create(curAnchor).EscapedText := '&xxxxxx;'; //wp: ??? +end; + +procedure TIpHtmlParser.ParseApplet(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + curApplet: TIpHtmlNodeAPPLET; + curParam: TIpHtmlNodePARAM; +begin + curApplet := TIpHtmlNodeAPPLET.Create(AParent); + with curApplet do begin + Codebase := FindAttribute(htmlAttrCODEBASE); + Code := FindAttribute(htmlAttrCODE); + Alt := FindAttribute(htmlAttrALT); + Name := FindAttribute(htmlAttrNAME); + Height := ParseInteger(htmlAttrHEIGHT, -1); + Width := ParseHyperLength(htmlAttrWIDTH, ''); + Width.OnChange := @WidthChanged; + Align := ParseImageAlignment(hiaBottom); + HSpace := ParseInteger(htmlAttrHSPACE, 1); + VSpace := ParseInteger(htmlAttrVSPACE, 1); + Archive := FindAttribute(htmlAttrARCHIVE); + ObjectCode := FindAttribute(htmlAttrOBJECT); + Id := FindAttribute(htmlAttrID); + ClassID := FindAttribute(htmlAttrCLASS); + Title := FindAttribute(htmlAttrTITLE); + Style := FindAttribute(htmlAttrSTYLE); + end; + NextToken; + while not (FCurToken in EndTokens + [IpHtmlTagAPPLETend]) do begin + case FCurToken of + IpHtmlTagPARAM: + begin + curParam := TIpHtmlNodePARAM.Create(curApplet); + with curParam do begin + Name := FindAttribute(htmlAttrNAME); + Value := FindAttribute(htmlAttrVALUE); + Id := FindAttribute(htmlAttrID); + ValueType := ParseObjectValueType; + end; + NextToken; + end; + else + ParseText(curApplet, [IpHtmlTagAPPLETend, IpHtmlTagPARAM]); + end; + end; + EnsureClosure(IpHtmlTagAPPLETend, EndTokens); +end; + +procedure TIpHtmlParser.ParseBase; +begin + NextToken; +end; + +procedure TIpHtmlParser.ParseBaseFont(AParent: TIpHtmlNode); +var + curBasefont: TIpHtmlNodeBASEFONT; +begin + curBasefont := TIpHtmlNodeBASEFONT.Create(AParent); +// if CurBasefont=nil then ; // ???? What's this????? + curBasefont.Size := ParseInteger(htmlAttrSIZE, 3); + NextToken; +end; + +procedure TIpHtmlParser.ParseBlink(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + curBlink: TIpHtmlNodeBLINK; +begin + curBlink := TIpHtmlNodeBLINK.Create(AParent); + NextToken; + ParseBodyText(curBlink, EndTokens + [IpHtmlTagBLINKend]); + EnsureClosure(IpHtmlTagBLINKend, EndTokens); +end; + +procedure TIpHtmlParser.ParseBlock(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +begin + case FCurToken of + IpHtmlTagH1: + ParseHeader(AParent, IpHtmlTagH1end, 1); + IpHtmlTagH2: + ParseHeader(AParent, IpHtmlTagH2end, 2); + IpHtmlTagH3: + ParseHeader(AParent, IpHtmlTagH3end, 3); + IpHtmlTagH4: + ParseHeader(AParent, IpHtmlTagH4end, 4); + IpHtmlTagH5: + ParseHeader(AParent, IpHtmlTagH5end, 5); + IpHtmlTagH6: + ParseHeader(AParent, IpHtmlTagH6end, 6); + {IpHtmlTagP: + ParseParagraph(AParent, EndTokens);} {moved to inline} + IpHtmlTagDIR: + ParseUnorderedList(AParent, IpHtmlTagDIRend, EndTokens); + IpHtmlTagMENU: + ParseUnorderedList(AParent, IpHtmlTagMENUend, EndTokens); + IpHtmlTagUL: + ParseUnorderedList(AParent, IpHtmlTagULend, EndTokens); + IpHtmlTagDL: + ParseDefinitionList(AParent, EndTokens); + IpHtmlTagOL: + ParseOrderedList(AParent, EndTokens); + IpHtmlTagPRE: + ParsePre(AParent, EndTokens); + IpHtmlTagBLOCKQUOTE: + ParseBlockQuote(AParent, EndTokens); + IpHtmlTagFORM: + ParseForm(AParent, EndTokens); + IpHtmlTagTABLE: + ParseTable(AParent, EndTokens); + IpHtmlTagIMG: + ParseIMG(AParent); + IpHtmlTagOBJECT: + ParseObject(AParent); + IpHtmlTagAPPLET: + ParseApplet(AParent, EndTokens); + IpHtmlTagADDRESS: + ParseAddress(AParent); + IpHtmlTagEof: + Exit; + IpHtmlTagFRAMESET: + ParseFrameSet(AParent, EndTokens + [IpHtmlTagFRAMESETend]); + IpHtmlTagUnknown: + if FlagErrors then + ReportError(SHtmlUnknownTok) + else + NextToken; + end; +end; + +procedure TIpHtmlParser.ParseBlockQuote(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + BQ: TIpHtmlNodeBLOCKQUOTE; +begin + BQ := TIpHtmlNodeBLOCKQUOTE.Create(AParent); + BQ.ParseBaseProps(FOwner); + NextToken; + ParseBodyText(BQ, EndTokens + [IpHtmlTagBLOCKQUOTEend]); + EnsureClosure(IpHtmlTagBLOCKQUOTEend, EndTokens); +end; + +procedure TIpHtmlParser.ParseBody(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + i: Integer; + Node: TIpHtmlNode; +begin + if FCurToken = IpHtmlTagFRAMESET then begin + ParseFrameSet(AParent, EndTokens); + Exit; + end; + + {lead token is optional} + if FCurToken = IpHtmlTagBODY then begin + TIpHtmlNodeBODY.Create(AParent); + with FOwner.Body do begin + BgColor := ColorFromString(FindAttribute(htmlAttrBGCOLOR)); + TextColor := ColorFromString(FindAttribute(htmlAttrTEXT)); + Link := ColorFromString(FindAttribute(htmlAttrLINK)); + VLink := ColorFromString(FindAttribute(htmlAttrVLINK)); + ALink := ColorFromString(FindAttribute(htmlAttrALINK)); + Background := FindAttribute(htmlAttrBACKGROUND); + ParseBaseProps(FOwner); + LoadAndApplyCSSProps; + end; + NextToken; + ParseBodyText(FOwner.Body, EndTokens + [IpHtmlTagBODYend]); + EnsureClosure(IpHtmlTagBODYend, EndTokens); + end else begin + ParseBodyText(AParent, EndTokens + [IpHtmlTagBODYend]); + FOwner.FixMissingBodyTag; + if FCurToken = IpHtmlTagBODYend then + NextToken; + end; +end; + +procedure TIpHtmlParser.ParseBodyText(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +begin + Inc(FInBlock); + try + while not (FCurToken in EndTokens) do begin + case FCurToken of + IpHtmlTagH1, + IpHtmlTagH2, + IpHtmlTagH3, + IpHtmlTagH4, + IpHtmlTagH5, + IpHtmlTagH6, + {IpHtmlTagP,} + IpHtmlTagDIR, + IpHtmlTagMENU, + IpHtmlTagUL, + IpHtmlTagDL, + IpHtmlTagOL, + IpHtmlTagPRE, + IpHtmlTagBLOCKQUOTE, + IpHtmlTagFORM, + IpHtmlTagTABLE, + IpHtmlTagIMG, + IpHtmlTagOBJECT, + IpHtmlTagAPPLET, + IpHtmlTagADDRESS, + IpHtmlTagFRAMESET : + ParseBlock(AParent, EndTokens); + IpHtmlTagBODY : + begin + if FOwner.Body = nil then begin + TIpHtmlNodeBODY.Create(AParent); + NextToken; + ParseBodyText(FOwner.Body, EndTokens); + end + else + ParseInline(AParent, EndTokens); + end; + IpHtmlTagEof : + Exit; + else + ParseInline(AParent, EndTokens); + end; + end; + finally + Dec(FInBlock); + end; +end; + +function TIpHtmlParser.ParseBoolean(const AttrNameSet: TIpHtmlAttributesSet): Boolean; +begin + Result := Length(FParmValueArray[AttrNameSet]) > 0; +end; + +procedure TIpHtmlParser.ParseBR(AParent: TIpHtmlNode); +var + br: TIpHtmlNodeBR; +begin + br := TIpHtmlNodeBR.Create(AParent); + br.Clear := ParseBRClear; + br.Id := FindAttribute(htmlAttrID); + br.ClassId :=FindAttribute(htmlAttrCLASS); + br.Title := FindAttribute(htmlAttrTITLE); + br.Style := FindAttribute(htmlAttrSTYLE); + NextToken; +end; + +function TIpHtmlParser.ParseBRClear: TIpHtmlBreakClear; +var + S : string; +begin + Result := hbcNone; + S := UpperCase(FindAttribute(htmlAttrCLEAR)); + if Length(S) = 0 then + exit; + + case S[1] of + 'A','C': if (S = 'ALL') or (S = 'CLEAR') then Result := hbcAll; + 'L': if S = 'LEFT' then Result := hbcLeft; + 'R': if S = 'RIGHT' then Result := hbcRight; + else + if FlagErrors then + ReportError(SHtmlInvAlign); + end; +end; + +function TIpHtmlParser.ParseButtonType: TIpHtmlButtonType; +const + TIpHtmlButtonTypeNames : array[TIpHtmlButtonType] of string = ( + 'SUBMIT', 'RESET', 'BUTTON' + ); +var + S: string; +begin + Result := hbtSubmit; + S := UpperCase(FindAttribute(htmlAttrTYPE)); + if Length(S) > 0 then + begin + for Result := Low(TIpHtmlButtonType) to High(TIpHtmlButtonType) do + if S = TIpHtmlButtonTypeNames[Result] then exit; + if FlagErrors then + ReportError(SHtmlInvType); + end; +end; + +function TIpHtmlParser.ParseCellAlign(ADefault: TIpHtmlAlign): TIpHtmlAlign; +begin + Result := GetAlignmentForStr(FindAttribute(htmlAttrALIGN), ADefault); +end; + +procedure TIpHtmlParser.ParseCenter(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + curContainer: TIpHtmlNodeDIV; +begin + curContainer := TIpHtmlNodeDIV.Create(AParent); + with curContainer do + Align := haCenter; + NextToken; + ParseBodyText(curContainer, EndTokens + [IpHtmlTagCENTERend]); + EnsureClosure(IpHtmlTagCENTERend, EndTokens); +end; + +procedure TIpHtmlParser.ParseColGroup(AParent: TIpHtmlNode); +var + curColGroup: TIpHtmlNodeCOLGROUP; + curCol: TIpHtmlNodeCOL; +begin + while FCurToken = IpHtmlTagCOLGROUP do begin + curColGroup := TIpHtmlNodeCOLGROUP.Create(AParent); + with curColGroup do begin + ParseBaseProps(FOwner); + Span := ParseInteger(htmlAttrSPAN, 1); + Width := ParseHyperMultiLength(htmlAttrWIDTH, ''); + end; + NextToken; + SkipTextTokens; + while FCurToken = IpHtmlTagCOL do begin + curCol := TIpHtmlNodeCOL.Create(curColGroup); + with curCol do begin + ParseBaseProps(FOwner); + Span := ParseInteger(htmlAttrSPAN, 1); + Width := ParseHyperMultiLength(htmlAttrWIDTH, ''); + end; + NextToken; + SkipTextTokens; + end; + if FCurToken = IpHtmlTagCOLGROUPend then + NextToken; + end; +end; + +procedure TIpHtmlParser.ParseDefinitionList(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + newDL: TIpHtmlNodeDL; +begin + newDL := TIpHtmlNodeDL.Create(AParent); + newDL.ParseBaseProps(FOwner); + newDL.Compact := ParseBoolean(htmlAttrCOMPACT); + NextToken; + ParseDefinitionListItems(newDL, EndTokens + [IpHtmlTagDLend]); + EnsureClosure(IpHtmlTagDLend, EndTokens); +end; + +procedure TIpHtmlParser.ParseDefinitionListItems(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + curDT: TIpHtmlNodeDT; + curDD: TIpHtmlNodeDD; +begin + while not (FCurToken in EndTokens) do begin + case FCurToken of + IpHtmlTagDT : + begin + curDT := TIpHtmlNodeDT.Create(AParent); + curDT.ParseBaseProps(FOwner); + NextToken; + ParseBodyText(curDT, [IpHtmlTagDD, IpHtmlTagDTend] + EndTokens); + if FCurToken = IpHtmlTagDTend then + NextToken; + end; + IpHtmlTagDD : + begin + curDD := TIpHtmlNodeDD.Create(AParent); + curDD.ParseBaseProps(FOwner); + NextToken; + ParseBodyText(curDD, [IpHtmlTagDT, IpHtmlTagDDend] + EndTokens); + if FCurToken = IpHtmlTagDDend then + NextToken; + end; + else + ParseBodyText(AParent, EndTokens + [IpHtmlTagDT, IpHtmlTagDD]); + end; + end; +end; + +procedure TIpHtmlParser.ParseDel(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + BQ: TIpHtmlNodeDEL; +begin + BQ:= TIpHtmlNodeDEL.Create(AParent); + BQ.ParseBaseProps(FOwner); + BQ.Cite := FindAttribute(htmlAttrCITE); + BQ.Datetime := FindAttribute(htmlAttrDATETIME); + NextToken; + ParseBodyText(BQ, EndTokens + [IpHtmlTagDELend]); + EnsureClosure(IpHtmlTagDELend, EndTokens); +end; + +function TIpHtmlParser.ParseDir: TIpHtmlDirection; +var + S : string; +begin + Result := hdLTR; + S := UpperCase(FindAttribute(htmlAttrDIR)); + if (Length(S) = 0) or (S = 'LTR') then + else + if (S = 'RTL') then + Result := hdRTL + else + if FlagErrors then + ReportError(SHtmlInvDir); +end; + +procedure TIpHtmlParser.ParseDiv(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + curDIV: TIpHtmlNodeDIV; +begin + curDIV := TIpHtmlNodeDIV.Create(AParent); + with curDIV do begin + Align := ParseAlignment; + ParseBaseProps(FOwner); + end; + NextToken; + ParseBodyText(curDIV, EndTokens + [IpHtmlTagDIVend]); + EnsureClosure(IpHtmlTagDIVend, EndTokens); +end; + +procedure TIpHtmlParser.ParseFont(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + curFont: TIpHtmlNodeFONT; +begin + curFont := TIpHtmlNodeFONT.Create(AParent); + with curFont do begin + Face := FindAttribute(htmlAttrFACE); + Size.Free; + Size := nil; + Size := ParseRelSize{('+0')}; + Size.OnChange := @SizeChanged; + Color := ColorFromString(FindAttribute(htmlAttrCOLOR)); + ParseBaseProps(FOwner); + end; + NextToken; + ParseBodyText(curFont, EndTokens + [IpHtmlTagFONTend]); + EnsureClosure(IpHtmlTagFONTend, EndTokens); +end; + +procedure TIpHtmlParser.ParseFontStyle(AParent: TIpHtmlNode; + StartToken: TIpHtmlToken; const EndTokens: TIpHtmlTokenSet); +var + curStyle: TIpHtmlNodeFontStyle; +begin + curStyle := TIpHtmlNodeFontStyle.Create(AParent); + case StartToken of + IpHtmlTagTT : + curStyle.Style := hfsTT; + IpHtmlTagI : + curStyle.Style := hfsI; + IpHtmlTagB : + curStyle.Style := hfsB; + IpHtmlTagU : + curStyle.Style := hfsU; + IpHtmlTagSTRIKE : + curStyle.Style := hfsSTRIKE; + IpHtmlTagS : + curStyle.Style := hfsS; + IpHtmlTagBIG : + curStyle.Style := hfsBIG; + IpHtmlTagSMALL : + curStyle.Style := hfsSMALL; + IpHtmlTagSUB : + curStyle.Style := hfsSUB; + IpHtmlTagSUP : + curStyle.Style := hfsSUP; + end; + curStyle.ParseBaseProps(FOwner); + NextToken; + ParseBodyText(curStyle, EndTokens); + EnsureClosure(succ(StartToken), EndTokens); +end; + +procedure TIpHtmlParser.ParseForm(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + newForm : TIpHtmlNodeFORM; +begin + newForm := TIpHtmlNodeFORM.Create(AParent); + with newForm do begin + Action := FindAttribute(htmlAttrACTION); + Method := ParseMethod; + Enctype := FindAttribute(htmlAttrENCTYPE); + Name := FindAttribute(htmlAttrNAME); + AcceptCharset := FindAttribute(htmlAttrACCEPT_CHARSET); + Accept := FindAttribute(htmlAttrACCEPT); + if Enctype = '' then + Enctype := 'application/x-www-form-urlencoded'; + if AcceptCharset = '' then + AcceptCharset := 'UNKNOWN'; + ParseBaseProps(FOwner); + end; + NextToken; + ParseBodyText(newForm, EndTokens + [IpHtmlTagFORMend]); + EnsureClosure(IpHtmlTagFORMend, EndTokens); +end; + +procedure TIpHtmlParser.ParseFormFields(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + curSelect: TIpHtmlNodeSELECT; + curTextArea: TIpHtmlNodeTEXTAREA; + curButton: TIpHtmlNodeBUTTON; + curOptGroup: TIpHtmlNodeOPTGROUP; + curLabel: TIpHtmlNodeLABEL; + curFieldset: TIpHtmlNodeFIELDSET; + curLegend: TIpHtmlNodeLEGEND; + curOption: TIpHtmlNodeOPTION; + curInput: TIpHtmlNodeINPUT; +begin + while not (FCurToken in EndTokens) do begin + case FCurToken of + IpHtmlTagINPUT: + begin + curInput := TIpHtmlNodeINPUT.Create(AParent); + FOwner.TabList.Add(curInput); + with curInput do begin + ParseBaseProps(FOwner); + InputType := ParseInputType; + Name := FindAttribute(htmlAttrNAME); + Value := FindAttribute(htmlAttrVALUE); + Checked := ParseBoolean(htmlAttrCHECKED); + Size := ParseInteger(htmlAttrSIZE, -1); + MaxLength := ParseInteger(htmlAttrMAXLENGTH, -1); + Src := FindAttribute(htmlAttrSRC); + Align := ParseImageAlignment(hiaBottom); + Disabled := ParseBoolean(htmlAttrDISABLED); + ReadOnly := ParseBoolean(htmlAttrREADONLY); + Alt := FindAttribute(htmlAttrALT); + TabIndex := ParseInteger(htmlAttrTABINDEX, -1); + end; + NextToken; + end; + IpHtmlTagBUTTON: + begin + curButton := TIpHtmlNodeBUTTON.Create(AParent); + FOwner.TabList.Add(curButton); + with curButton do begin + ParseBaseProps(FOwner); + ButtonType := ParseButtonType; + Name := FindAttribute(htmlAttrNAME); + Value := FindAttribute(htmlAttrVALUE); + Disabled := ParseBoolean(htmlAttrDISABLED); + TabIndex := ParseInteger(htmlAttrTABINDEX, -1); + end; + NextToken; + ParseBodyText(curButton, EndTokens + [IpHtmlTagBUTTONend]); + if FCurToken = IpHtmlTagBUTTONend then + NextToken + else + if FlagErrors then + ReportExpectedToken(IpHtmlTagBUTTONend); + end; + IpHtmlTagSELECT: + begin + curSelect := TIpHtmlNodeSELECT.Create(AParent); + with curSelect do begin + Name := FindAttribute(htmlAttrNAME); + Size := ParseInteger(htmlAttrSIZE, -1); + Width := ParseInteger(htmlAttrWIDTH, -1); + ParseBaseProps(FOwner); + Multiple := ParseBoolean(htmlAttrMULTIPLE); + ComboBox := ParseBoolean(htmlAttrCOMBOBOX); + Disabled := ParseBoolean(htmlAttrDISABLED); + TabIndex := ParseInteger(htmlAttrTABINDEX, -1); + Alt := FindAttribute(htmlAttrALT); + end; + NextNonBlankToken; + repeat + case FCurToken of + IpHtmlTagOPTION : + begin + curOption := TIpHtmlNodeOPTION.Create(curSelect); + with curOption do begin + ParseBaseProps(FOwner); + Selected := ParseBoolean(htmlAttrSELECTED); + Value := FindAttribute(htmlAttrVALUE); + Disabled := ParseBoolean(htmlAttrDISABLED); + OptionLabel := FindAttribute(htmlAttrLABEL); + end; + NextNonBlankToken; + ParseText(curOption, EndTokens + [IpHtmlTagSelectEND, IpHtmlTagOption, IpHtmlTagOPTIONend]); + if FCurToken = IpHtmlTagOPTIONend then + NextNonBlankToken; + end; + IpHtmlTagOPTGROUP : + begin + curOptGroup := TIpHtmlNodeOPTGROUP.Create(curSelect); + with curOptGroup do begin + ParseBaseProps(FOwner); + Disabled := ParseBoolean(htmlAttrDISABLED); + GroupLabel := FindAttribute(htmlAttrLABEL); + end; + NextNonBlankToken; + while FCurToken = IpHtmlTagOPTION do begin + curOption := TIpHtmlNodeOPTION.Create(curOptGroup); + FOwner.TabList.Add(curOption); + with curOption do begin + ParseBaseProps(FOwner); + Selected := ParseBoolean(htmlAttrSELECTED); + Value := FindAttribute(htmlAttrVALUE); + Disabled := ParseBoolean(htmlAttrDISABLED); + OptionLabel := FindAttribute(htmlAttrLABEL); + end; + NextNonBlankToken; + ParseText(curOption, EndTokens + [IpHtmlTagSelectEND, IpHtmlTagOption, IpHtmlTagOPTIONend]); + if FCurToken = IpHtmlTagOPTIONend then + NextNonBlankToken; + end; + if FCurToken = IpHtmlTagOPTGROUPend then + NextNonBlankToken + else + if FCurToken = IpHtmlTagOPTGROUP then + else + if FCurToken = IpHtmlTagOPTION then + else + if FCurToken = IpHtmlTagSELECTend then + else + if FlagErrors then + ReportExpectedToken(IpHtmlTagOPTGROUPend); + end; + else + break; + end; + until False; + if FCurToken = IpHtmlTagSELECTend then + NextNonBlankToken; + end; + IpHtmlTagTEXTAREA: + begin + curTextArea := TIpHtmlNodeTEXTAREA.Create(AParent); + FOwner.TabList.Add(curTextArea); + with curTextArea do begin + Name := FindAttribute(htmlAttrNAME); + Rows := ParseInteger(htmlAttrROWS, 20); + Cols := ParseInteger(htmlAttrCOLS, 20); + ParseBaseProps(FOwner); + Disabled := ParseBoolean(htmlAttrDISABLED); + ReadOnly := ParseBoolean(htmlAttrREADONLY); + TabIndex := ParseInteger(htmlAttrTABINDEX, -1); + Alt := FindAttribute(htmlAttrALT); + end; + NextToken; + ParseText(curTextArea, [IpHtmlTagTEXTAREAend]); + if FCurToken = IpHtmlTagTEXTAREAend then + NextToken + else + if FlagErrors then + ReportExpectedToken(IpHtmlTagTEXTAREAend); + end; + IpHtmlTagLABEL : + begin + curLabel := TIpHtmlNodeLABEL.Create(AParent); + with curLabel do begin + ParseBaseProps(FOwner); + LabelFor := FindAttribute(htmlAttrLABEL); + end; + NextToken; + ParseBodyText(curLabel, [IpHtmlTagLABELend]); + if FCurToken = IpHtmlTagLABELend then + NextToken + else + if FlagErrors then + ReportExpectedToken(IpHtmlTagLABELend); + end; + IpHtmlTagFIELDSET : + begin + curFieldset := TIpHtmlNodeFIELDSET.Create(AParent); + with curFieldset do + ParseBaseProps(FOwner); + NextToken; + ParseFormFields(curFieldSet, EndTokens + [IpHtmlTagFIELDSETend]); + if FCurToken = IpHtmlTagFIELDSETend then + NextToken + else + if FlagErrors then + ReportExpectedToken(IpHtmlTagFIELDSETend); + end; + IpHtmlTagLEGEND : + begin + curLegend := TIpHtmlNodeLEGEND.Create(AParent); + with curLegend do begin + ParseBaseProps(FOwner); + end; + NextToken; + ParseBodyText(CurLegend, [IpHtmlTagLEGENDend]); + if FCurToken = IpHtmlTagLEGENDend then + NextToken + else + if FlagErrors then + ReportExpectedToken(IpHtmlTagLEGENDend); + end; + else + Exit; + end; + end; +end; + +procedure TIpHtmlParser.ParseFrame(AParent: TIpHtmlNode); +var + curFrame: TIpHtmlNodeFRAME; +begin + curFrame := TIpHtmlNodeFRAME.Create(AParent); + with curFrame do begin + LongDesc := FindAttribute(htmlAttrLONGDESC); + Name := FindAttribute(htmlAttrNAME); + Src := FindAttribute(htmlAttrSRC); + FrameBorder := ParseInteger(htmlAttrBORDER, 1); + MarginWidth := ParseInteger(htmlAttrMARGINWIDTH, 1); + MarginHeight := ParseInteger(htmlAttrMARGINHEIGHT, 1); + NoResize := ParseBoolean(htmlAttrNORESIZE); + Scrolling := ParseFrameScrollingProp; + ParseBaseProps(FOwner); + end; + NextToken; +end; + +function TIpHtmlParser.ParseFrameProp(ADefault: TIpHtmlFrameProp): TIpHtmlFrameProp; +var + S: string; +begin + Result := hfVoid; + S := UpperCase(FindAttribute(htmlAttrFRAME)); + if Length(S) = 0 then + begin + Result := ADefault; + exit; + end; + + case S[1] of + 'A': if (S = 'ABOVE') then Result := hfAbove; + 'B': if S = 'BELOW' then Result := hfBelow + else if S = 'BOX' then Result := hfBox + else if S = 'BORDER' then Result := hfBorder; + 'H': if S = 'HSIDES' then Result := hfHSides; + 'L': if S = 'LHS' then Result := hfLhs; + 'R': if S = 'RHS' then Result := hfRhs; + 'V': if (S = 'VOID') then exit + else if S = 'VSIDES' then + Result := hfvSides; + else + if FlagErrors then + ReportError(SHtmlInvFrame); + end; +end; + +function TIpHtmlParser.ParseFrameScrollingProp: TIpHtmlFrameScrolling; +var + S: string; +begin + Result := hfsAuto; + S := UpperCase(FindAttribute(htmlAttrSCROLLING)); + if (length(S) = 0) then exit; + case S[1] of + 'A': if (S = 'AUTO') then exit; + 'N': if S = 'NO' then Result := hfsNo; + 'Y': if S = 'YES' then Result := hfsYes; + else + if FlagErrors then + ReportError(SHtmlInvScroll); + end; +end; + +procedure TIpHtmlParser.ParseFrameSet(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +begin + FHasFrames := True; + while FCurToken = IpHtmlTagFRAMESET do begin + FCurFrameSet := TIpHtmlNodeFRAMESET.Create(AParent); + with FCurFrameSet do begin + Rows := ParseHyperMultiLengthList(htmlAttrROWS, '100%'); + Cols := ParseHyperMultiLengthList(htmlAttrCOLS, '100%'); + Id := FindAttribute(htmlAttrID); + ClassId := FindAttribute(htmlAttrCLASS); + Title := FindAttribute(htmlAttrTITLE); + Style := FindAttribute(htmlAttrSTYLE); + end; + NextToken; + if FCurToken = IpHtmlTagFRAMESET then + ParseFrameSet(FCurFrameSet, EndTokens + [IpHtmlTagFRAMESETend]); + while FCurToken = IpHtmlTagFRAME do + ParseFrame(FCurFrameSet); + if FCurToken = IpHtmlTagNOFRAMES then + ParseNOFRAMES(FCurFrameSet); + if FCurToken = IpHtmlTagFRAMESETend then + NextToken; + end; +end; + +procedure TIpHtmlParser.ParseHead(AParent: TIpHtmlNode); +var + L: TStringListUTF8Fast; +begin + {lead token is optional} + if FCurToken = IpHtmlTagHEAD then begin + NextToken; + ParseHeadItems(TIpHtmlNodeHEAD.Create(AParent)); + if FCurToken = IpHtmlTagHEADend then + NextToken; + end; + + L := TStringListUTF8Fast.Create; + try + GetSupportedEncodings(L); + if L.IndexOf(FDocCharset) = 0 then // clear for UTF-8 to avoid conversion + FDocCharset := ''; + finally + L.Free; + end; +end; + +procedure TIpHtmlParser.ParseHeader(AParent: TIpHtmlNode; EndToken: TIpHtmlToken; + ASize: Integer); +var + newHeader: TIpHtmlNodeHeader; +begin + newHeader := TIpHtmlNodeHeader.Create(AParent); + newHeader.ElementName := 'h' + IntToStr(ASize); + newHeader.ParseBaseProps(FOwner); + newHeader.Size := ASize; + newHeader.Align := ParseAlignment; + NextToken; + ParseBodyText(newHeader, [EndToken]); + if FCurToken = EndToken then + NextToken + else if FlagErrors then + ReportExpectedToken(EndToken); +end; + +procedure TIpHtmlParser.ParseHeadItems(AParent: TIpHtmlNode); +begin + while not (FCurToken in [IpHtmlTagEOF, IpHtmlTagHEADend, IpHtmlTagFRAMESET, IpHtmlTagBODY]) do + begin + case FCurToken of + IpHtmlTagTITLE : + ParseTitle(AParent); + IpHtmlTagSTYLE : + ParseStyle(AParent); + IpHtmlTagSCRIPT : + ParseScript(AParent, [IpHtmlTagEOF]); + IpHtmlTagNOSCRIPT : + ParseNoscript(AParent); + IpHtmlTagISINDEX : + ParseIsIndex; + IpHtmlTagBASE : + ParseBase; + IpHtmlTagMETA : + ParseMeta(AParent); + IpHtmlTagLINK : + ParseLink(AParent); + else + NextToken; // unknown + end; + end; +end; + +procedure TIpHtmlParser.ParseHR(AParent: TIpHtmlNode); +var + newRule: TIpHtmlNodeHR; +begin + newRule := TIpHtmlNodeHR.Create(AParent); + with newRule do begin + Align := ParseImageAlignment(hiaCenter); + NoShade := ParseBoolean(htmlAttrNOSHADE); + Size := ParseHtmlInteger2(htmlAttrSIZE, 1); + Size.OnChange := @WidthChanged; + Width := ParseHyperLength(htmlAttrWIDTH, '100%'); + Width.OnChange := @WidthChanged; + Color := ColorFromString(FindAttribute(htmlAttrCOLOR)); + ParseBaseProps(FOwner); + end; + NextToken; +end; + +procedure TIpHtmlParser.ParseHtml; +begin + {lead token is optional} + if FCurToken = IpHtmlTagHtml then begin + FOwner.HtmlNode.Version := FindAttribute(htmlAttrVERSION); + FOwner.HtmlNode.Lang := FindAttribute(htmlAttrLANG); + FOwner.HtmlNode.Dir := ParseDir; + NextToken; + ParseHead(FOwner.HtmlNode); {may not be present} + ParseBody(FOwner.HtmlNode, [IpHtmlTagHtmlend, IpHtmlTagEOF]); {may not be present} + if FCurToken in [IpHtmlTagHtmlend, IpHtmlTagEOF] then + else + if FlagErrors then + ReportExpectedToken(IpHtmlTagHtmlend); + NextToken; + end else begin + ParseHead(FOwner.HtmlNode); {may not be present} + ParseBody(FOwner.HtmlNode, [IpHtmlTagEof]); {may not be present} + end; +end; + +function TIpHtmlParser.ParseHyperLength(const AttrNameSet: TIpHtmlAttributesSet; + const ADefault: string): TIpHtmlLength; +var + S: string; + n, P, Err: Integer; +begin + Result := TIpHtmlLength.Create; + Result.LengthType := hlUndefined; + S := FindAttribute(AttrNameSet); + if Length(S) = 0 then + begin + if Length(aDefault) = 0 then + exit + else + S := ADefault; + end; + P := CharPos('%', S); + if P <> 0 then begin + Result.LengthType := hlPercent; + Delete(S, P, 1); + end else + Result.LengthType := hlAbsolute; + val(S, n, Err); + Result.LengthValue := n; + if (Err <> 0) or (Result.LengthValue < 0) then begin + if FlagErrors then + ReportError(SHtmlInvInt) + else + Result.LengthType := hlUndefined; + end else + if (Result.LengthType = hlPercent) and (Result.LengthValue > 100) then + Result.LengthValue := 100; +end; + +function TIpHtmlParser.ParseHyperMultiLength(const AttrNameSet: TIpHtmlAttributesSet; + const ADefault: string): TIpHtmlMultiLength; +var + S : string; + n, P, Err: Integer; +begin + Result := TIpHtmlMultiLength.Create; + Result.LengthType := hmlUndefined; + S := FindAttribute(AttrNameSet); + if Length(S) = 0 then + begin + if Length(ADefault) = 0 then + exit + else + S := ADefault; + end; + P := CharPos('%', S); + if P <> 0 then begin + Result.LengthType := hmlPercent; + Delete(S, P, 1); + end else begin + P := CharPos('*', S); + if P <> 0 then begin + Result.LengthType := hmlRelative; + Delete(S, P, 1); + end else + Result.LengthType := hmlAbsolute; + end; + val(s, n, Err); + Result.LengthValue := n; + if (Err <> 0) or (Result.LengthValue < 0) then begin + if FlagErrors then + ReportError(SHtmlInvInt) + else + Result.LengthType := hmlUndefined; + end; +end; + +function TIpHtmlParser.ParseHyperMultiLengthList(const AttrNameSet: TIpHtmlAttributesSet; + const ADefault: string): TIpHtmlMultiLengthList; +var + S, S2: string; + B, E, P, Err, n: Integer; + NewEntry: TIpHtmlMultiLength; +begin + Result := TIpHtmlMultiLengthList.Create; + S := FindAttribute(AttrNameSet); + if Length(S) = 0 then + begin + if length(ADefault) = 0 then + exit + else + S := ADefault; + end; + B := 1; + while B <= length(S) do begin + E := B; + repeat + Inc(E); + until (E > Length(S)) or (S[E] = ','); + S2 := copy(S, B, E - B); + newEntry := TIpHtmlMultiLength.Create; + newEntry.LengthType := hmlUndefined; + P := CharPos('%', S2); + if P <> 0 then begin + newEntry.LengthType := hmlPercent; + Delete(S2, P, 1); + end else begin + P := CharPos('*', S2); + if P <> 0 then begin + newEntry.LengthType := hmlRelative; + Delete(S2, P, 1); + end else + newEntry.LengthType := hmlAbsolute; + end; + if S2 = '' then + newEntry.LengthValue := 0 + else begin + val(S2, n, Err); + newEntry.LengthValue := n; + if (Err <> 0) or (NewEntry.LengthValue < 0) then begin + if FlagErrors then + ReportError(SHtmlInvInt) + else + newEntry.LengthType := hmlUndefined; + end; + end; + Result.AddEntry(newEntry); + B := E + 1; + end; +end; + +procedure TIpHtmlParser.ParseIFrame(AParent: TIpHtmlNode); +var + curFrame: TIpHtmlNodeIFRAME; +begin + curFrame := TIpHtmlNodeIFRAME.Create(AParent); + with curFrame do begin + LongDesc := FindAttribute(htmlAttrLONGDESC); + Name := FindAttribute(htmlAttrNAME); + Src := FindAttribute(htmlAttrSRC); + FrameBorder := ParseInteger(htmlAttrBORDER, 1); + MarginWidth := ParseInteger(htmlAttrMARGINWIDTH, 1); + MarginHeight := ParseInteger(htmlAttrMARGINHEIGHT, 1); + Scrolling := ParseFrameScrollingProp; + Align := ParseAlignment; + Height := ParseHyperLength(htmlAttrHEIGHT, ''); + Height.OnChange := @WidthChanged; + Width := ParseHyperLength(htmlAttrWIDTH, ''); + Width.OnChange := @WidthChanged; + ParseBaseProps(FOwner); + end; + NextToken; + ParseBodyText(curFrame, [IpHtmlTagIFRAMEend]); + if FCurToken = IpHtmlTagIFRAMEend then + NextToken; +end; + +function TIpHtmlParser.ParseImageAlignment(ADefault: TIpHtmlImageAlign): TIpHtmlImageAlign; +const + TIpHtmlImageAlignNames : array[TIpHtmlImageAlign] of string = ( + 'TOP', 'MIDDLE', 'BOTTOM', 'LEFT', 'RIGHT', 'CENTER'); +var + S : string; +begin + Result := aDefault; + S := UpperCase(FindAttribute(htmlAttrALIGN)); + if Length(S) = 0 then exit; + for Result := Low(TIpHtmlImageAlign) to High(TIpHtmlImageAlign) do + if S = TIpHtmlImageAlignNames[Result] then + exit; + + if FlagErrors then + ReportError(SHtmlInvAlign); +end; + +procedure TIpHtmlParser.ParseImg(AParent: TIpHtmlNode); +var + curIMG : TIpHtmlNodeIMG; +begin + curIMG := TIpHtmlNodeIMG.Create(AParent); + with curIMG do begin + Src := FindAttribute(htmlAttrSRC); + Alt := FindAttribute(htmlAttrALT); + Align := ParseImageAlignment(hiaBottom); + Height := ParsePixels(htmlAttrHEIGHT, ''); + Height.OnChange := @DimChanged; + Width := ParseHyperLength(htmlAttrWIDTH, ''); + Width.OnChange := @DimChanged; + Border := ParseInteger(htmlAttrBORDER, 0); + HSpace := ParseInteger(htmlAttrHSPACE, 0); + VSpace := ParseInteger(htmlAttrVSPACE, 0); + UseMap := FindAttribute(htmlAttrUSEMAP); + IsMap := ParseBoolean(htmlAttrISMAP); + ParseBaseProps(FOwner); + LongDesc := FindAttribute(htmlAttrLONGDESC); + Name := FindAttribute(htmlAttrNAME); + end; + NextToken; +end; + +procedure TIpHtmlParser.ParseInline(AParent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet); +begin + case FCurToken of + IpHtmlTagP: + ParseParagraph(AParent, EndTokens); {moved from block} + IpHtmlTagFont: + ParseFont(AParent, EndTokens); + IpHtmlTagDIV: + ParseDiv(AParent, EndTokens); + IpHtmlTagSPAN: + ParseSpan(AParent, EndTokens); + IpHtmlTagLEFT: + ParseLeft(AParent, EndTokens); + IpHtmlTagCENTER: + ParseCenter(AParent, EndTokens); + IpHtmlTagRIGHT: + ParseRight(AParent, EndTokens); + IpHtmlTagBLINK: + ParseBlink(AParent, EndTokens); + IpHtmlTagQ: + ParseQ(AParent, EndTokens); + IpHtmlTagHR: + ParseHR(AParent); + IpHtmlTagTT, IpHtmlTagI, IpHtmlTagB, IpHtmlTagU, IpHtmlTagSTRIKE, IpHtmlTagS, + IpHtmlTagBIG, IpHtmlTagSMALL, IpHtmlTagSUB, IpHtmlTagSUP : + ParseFontStyle(AParent, FCurToken, EndTokens + [succ(FCurToken)]); + IpHtmlTagEM, IpHtmlTagSTRONG, IpHtmlTagDFN, IpHtmlTagCODE, + IpHtmlTagSAMP, IpHtmlTagKBD, IpHtmlTagVAR, IpHtmlTagCITE, + IpHtmlTagABBR, IpHtmlTagACRONYM : + ParsePhraseElement(AParent, FCurToken, succ(FCurToken), EndTokens); + IpHtmlTagA: + ParseAnchor(AParent, EndTokens); + IpHtmlTagBASEFONT: + ParseBaseFont(AParent); + IpHtmlTagBR: + ParseBR(AParent); + IpHtmlTagNOBR: + ParseNOBR(AParent); + IpHtmlTagMAP: + ParseMAP(AParent, EndTokens); + IpHtmlTagText: + begin + if FInPre > 0 then + TIpHtmlNodeText.Create(AParent).ANSIText := GetTokenString + else + TIpHtmlNodeText.Create(AParent).EscapedText := GetTokenString; + NextToken; + end; + IpHtmlTagINPUT, + IpHtmlTagSELECT, + IpHtmlTagButton, + IpHtmlTagTEXTAREA: + ParseFormFields(AParent, EndTokens); + IpHtmlTagINS: + ParseIns(AParent, EndTokens); + IpHtmlTagDEL: + ParseDel(AParent, EndTokens); + IpHtmlTagIFRAME: + ParseIFRAME(AParent); + IpHtmlTagSCRIPT: + ParseScript(AParent, EndTokens); + IpHtmlTagNOSCRIPT: + ParseNoscript(AParent); + IpHtmlTagSTYLE: + ParseStyle(AParent); + else + NextToken; + end; +end; + +function TIpHtmlParser.ParseInputType: TIpHtmlInputType; +const + IpHtmlInputTypeNames: array[TIpHtmlInputType] of string = ( + 'TEXT', 'PASSWORD', 'CHECKBOX', 'RADIO', + 'SUBMIT', 'RESET', 'FILE', 'HIDDEN', 'IMAGE', 'BUTTON' + ); +var + S : string; +begin + Result := hitText; + S := UpperCase(FindAttribute(htmlAttrTYPE)); + if (Length(S) = 0) or (S = 'TEXTAREA') then + // + else + begin + for Result := Low(TIpHtmlInputType) to High(TIpHtmlInputType) do + if S = IpHtmlInputTypeNames[Result] then exit; + if FlagErrors then + ReportError(SHtmlInvType); + end; +end; + +procedure TIpHtmlParser.ParseIns(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + BQ: TIpHtmlNodeINS; +begin + BQ := TIpHtmlNodeINS.Create(AParent); + BQ.ParseBaseProps(FOwner); + BQ.Cite := FindAttribute(htmlAttrCITE); + BQ.Datetime := FindAttribute(htmlAttrDATETIME); + NextToken; + ParseBodyText(BQ, EndTokens + [IpHtmlTagINSend]); + EnsureClosure(IpHtmlTagINSend, EndTokens); +end; + +function TIpHtmlParser.ParseInteger(const AttrNameSet: TIpHtmlAttributesSet; + ADefault: Integer): Integer; +var + S: string; + Err: Integer; + AttrName: string; +begin + AttrName := TIpHtmlAttributesNames[AttrNameSet]; + S := FindAttribute(AttrNameSet); + if Length(S) = 0 then + Result := ADefault + else + if CompareText(S, AttrName) = 0 then + Result := 1 + else begin + Val(S, Result, Err); + if Err <> 0 then begin + Result := ADefault; + if FlagErrors then + ReportError(SHtmlInvInt) + end; + end; +end; + +function TIpHtmlParser.ParseHtmlInteger2(const AttrNameSet: TIpHtmlAttributesSet; + ADefault: Integer): TIpHtmlInteger; +begin + Result := TIpHtmlInteger.Create(ParseInteger(AttrNameSet, aDefault)); +end; + +procedure TIpHtmlParser.ParseIsIndex; +begin + FIndexPhrase := FindAttribute(htmlAttrPROMPT); + NextToken; +end; + +procedure TIpHtmlParser.ParseLeft(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + curContainer: TIpHtmlNodeDIV; +begin + curContainer := TIpHtmlNodeDIV.Create(AParent); + with curContainer do + Align := haLeft; + NextToken; + ParseBodyText(curContainer, EndTokens + [IpHtmlTagLEFTend]); + EnsureClosure(IpHtmlTagLEFTend, EndTokens); +end; + +procedure TIpHtmlParser.ParseLink(AParent: TIpHtmlNode); +begin + with TIpHtmlNodeLINK.Create(AParent) do begin + HRef := FindAttribute(htmlAttrHREF); + Rel := FindAttribute(htmlAttrREL); + Rev := FindAttribute(htmlAttrREV); + Title := FindAttribute(htmlAttrTITLE); + Type_ := LowerCase(FindAttribute(htmlAttrTYPE)); + if (LowerCase(Rel) = 'stylesheet') and (Type_ = 'text/css') then + ParseStyleSheet(AParent, Href); + ParseBaseProps(FOwner); + end; + NextToken; +end; + +procedure TIpHtmlParser.ParseListItems(AParent: TIpHtmlNodeCore; + EndToken: TIpHtmlToken; const EndTokens: TIpHtmlTokenSet; + ADefaultListStyle: TIpHtmlULType); +var + newListItem: TIpHtmlNodeLI; +begin + while not (FCurToken in EndTokens) do begin + case FCurToken of + IpHtmlTagLI : + begin + newListItem := TIpHtmlNodeLI.Create(AParent); + newListItem.ParseBaseProps(FOwner); + // newListItem.DefListType := DefaultListStyle; + newListItem.ListType := ParseULStyle(ADefaultListStyle); + newListItem.Value := ParseInteger(htmlAttrVALUE, -1); + newListItem.Compact := ParseBoolean(htmlAttrCOMPACT); + NextToken; + ParseBodyText( + newListItem, + EndTokens + [EndToken, IpHtmlTagLI, IpHtmlTagLIend] - [IpHtmlTagP, IpHtmlTagPend] + ); + if FCurToken = IpHtmlTagLIend then + NextToken; + SkipTextTokens; + end; + else + ParseBodyText(AParent, EndTokens + [EndToken, IpHtmlTagLI]); + end; + end; +end; + +procedure TIpHtmlParser.ParseMap(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + curMap: TIpHtmlNodeMAP; +begin + curMap := TIpHtmlNodeMAP.Create(AParent); + curMap.Name := FindAttribute(htmlAttrNAME); + curMap.ParseBaseProps(FOwner); + NextToken; + while not (FCurToken in EndTokens + [IpHtmlTagMAPend]) do begin + case FCurToken of + IpHtmlTagAREA : + begin + with TIpHtmlNodeAREA.Create(curMap) do begin + Shape := ParseShape; + Coords := FindAttribute(htmlAttrCOORDS); + HRef := FindAttribute(htmlAttrHREF); + NoHRef := ParseBoolean(htmlAttrNOHREF); + Alt := FindAttribute(htmlAttrALT); + TabIndex := ParseInteger(htmlAttrTABINDEX, -1); + Target := FindAttribute(htmlAttrTARGET); + ParseBaseProps(FOwner); + end; + NextToken; + end; + else + if FlagErrors then + ReportExpectedError(' or ') + else + NextToken; + end; + end; + EnsureClosure(IpHtmlTagMAPend, EndTokens); +end; + +procedure TIpHtmlParser.ParseMeta(AParent: TIpHtmlNode); +var + i,j: Integer; +begin + with TIpHtmlNodeMETA.Create(AParent) do begin + HttpEquiv := FindAttribute(htmlAttrHTTP_EQUIV); + Name := FindAttribute(htmlAttrNAME); + Content := FindAttribute(htmlAttrCONTENT); + if not FHasBOM then begin + if SameText(HttpEquiv, 'content-type') then begin + j := PosI('charset=', Content); + if j>0 then begin + j := j+8; + i := j; + while (j <= Length(Content)) do begin + if Content[j] in [' ',';','"',','] then + break; + inc(j); + end; + fDocCharset := copy(content, i, j-i); + end; + end + else + fDocCharset := FindAttribute(htmlAttrCHARSET); + if LazStartsText('windows', fDocCharset) then + fDocCharset := NormalizeEncoding(StringReplace(fDocCharset, 'windows', 'cp', [rfIgnoreCase])); + end; + Scheme := FindAttribute(htmlAttrSCHEME); + end; + NextToken; +end; + +function TIpHtmlParser.ParseMethod: TIpHtmlFormMethod; +var + S: string; +begin + Result := hfmGet; + S := UpperCase(FindAttribute(htmlAttrMETHOD)); + if (Length(S) = 0) or (S = 'GET') then + else + if S = 'POST' then + Result := hfmPost + else + if FlagErrors then + ReportError(SHtmlInvMethod); +end; + +procedure TIpHtmlParser.ParseNOBR(AParent: TIpHtmlNode); +begin + NextToken; + ParseBodyText(TIpHtmlNodeNOBR.Create(AParent), [IpHtmlTagNOBRend]); + if FCurToken = IpHtmlTagNOBRend then + NextToken + else + if FlagErrors then + ReportExpectedToken(IpHtmlTagNOBRend); +end; + +procedure TIpHtmlParser.ParseNoFrames(AParent: TIpHtmlNode); +var + curNoFrames: TIpHtmlNodeNOFRAMES; +begin + curNoFrames := TIpHtmlNodeNOFRAMES.Create(AParent); + NextToken; + ParseBodyText(curNoFrames, [IpHtmlTagNOFRAMESend, IpHtmlTagFRAMESETend]); + if FCurToken = IpHtmlTagNOFRAMESend then + NextToken; +end; + +procedure TIpHtmlParser.ParseNoScript(AParent: TIpHtmlNode); +var + curScript: TIpHtmlNodeNOSCRIPT; +begin + curScript := TIpHtmlNodeNOSCRIPT.Create(AParent); + with curScript do begin + ParseBaseProps(FOwner); + end; + NextToken; + ParseBodyText(curScript, [IpHtmlTagNOSCRIPTend]); + if FCurToken = IpHtmlTagNOSCRIPTend then + NextToken + else + if FlagErrors then + ReportExpectedToken(IpHtmlTagNOSCRIPTend); +end; + +procedure TIpHtmlParser.ParseObject(AParent: TIpHtmlNode); +var + curObject: TIpHtmlNodeOBJECT; + curParam: TIpHtmlNodePARAM; +begin + curObject := TIpHtmlNodeOBJECT.Create(AParent); + with curOBJECT do begin + ClassID := FindAttribute(htmlAttrCLASSID); + Codebase := FindAttribute(htmlAttrCODEBASE); + Data := FindAttribute(htmlAttrDATA); + CodeType := FindAttribute(htmlAttrCODETYPE); + Archive := FindAttribute(htmlAttrARCHIVE); + Standby := FindAttribute(htmlAttrSTANDBY); + Align := ParseImageAlignment(hiaBottom); + Height := ParseInteger(htmlAttrHEIGHT, -1); + Width := ParseHyperLength(htmlAttrWIDTH, ''); + Width.OnChange := @WidthChanged; + Border := ParseInteger(htmlAttrBORDER, 0); + HSpace := ParseInteger(htmlAttrHSPACE, 1); + VSpace := ParseInteger(htmlAttrVSPACE, 1); + UseMap := FindAttribute(htmlAttrUSEMAP); + Declare := ParseBoolean(htmlAttrDECLARE); + ParseBaseProps(FOwner); + Name := FindAttribute(htmlAttrNAME); + end; + NextToken; + while not (FCurToken = IpHtmlTagOBJECTend) do begin + case FCurToken of + IpHtmlTagPARAM : + begin + curParam := TIpHtmlNodePARAM.Create(curObject); + with curParam do begin + Name := FindAttribute(htmlAttrNAME); + Value := FindAttribute(htmlAttrVALUE); + Id := FindAttribute(htmlAttrID); + ValueType := ParseObjectValueType; + end; + NextToken; + end; + else + ParseText(curObject, [IpHtmlTagOBJECTend, IpHtmlTagPARAM]); + end; + end; + if FCurToken = IpHtmlTagOBJECTend then + NextToken + else + if FlagErrors then + ReportExpectedToken(IpHtmlTagOBJECTend); +end; + +function TIpHtmlParser.ParseObjectValueType: TIpHtmlObjectValueType; +var + S: string; +begin + Result := hovtData; + S := UpperCase(FindAttribute(htmlAttrVALUETYPE)); + if Length(S) = 0 then + exit; + case S[1] of + 'D': if S = 'DATA' then exit; + 'O': if S = 'OBJECT' then Result := hovtObject; + 'R': if S = 'REF' then Result := hovtRef; + else + if FlagErrors then + ReportError(SHtmlInvValType); + end; +end; + +function TIpHtmlParser.ParseOLStyle(ADefault: TIpHtmlOLStyle): TIpHtmlOLStyle; +const + TIpHtmlOLStyleNames : array[TIpHtmlOLStyle] of char = ('1', 'a', 'A', 'i', 'I'); +var + S : string; +begin + Result := ADefault; + S := FindAttribute(htmlAttrTYPE); + if Length(S) > 0 then + begin + for Result := Low(TIpHtmlOLStyle) to High(TIpHtmlOLStyle) do + if S = TIpHtmlOLStyleNames[Result] then exit; + if FlagErrors then + ReportError(SHtmlInvType); + end; +end; + +procedure TIpHtmlParser.ParseOrderedList(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + newList: TIpHtmlNodeOL; +begin + newList := TIpHtmlNodeOL.Create(AParent); + newList.Style := ParseOLStyle(olArabic); + newList.Start := ParseInteger(htmlAttrSTART, 1); + newList.Compact := ParseBoolean(htmlAttrCOMPACT); + NextToken; + ParseListItems(newList, IpHtmlTagOLend, EndTokens + [IpHtmlTagOLend], ulDisc); + EnsureClosure(IpHtmlTagOLend, EndTokens); +end; + +procedure TIpHtmlParser.ParseParagraph(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + newPara: TIpHtmlNodeP; +begin + newPara := TIpHtmlNodeP.Create(AParent); + newPara.ParseBaseProps(FOwner); + newPara.Align := ParseAlignment; + NextToken; + ParseBodyText(newPara, EndTokens + [IpHtmlTagPend, IpHtmlTagP, IpHtmltagTABLE]); + if FCurToken = IpHtmlTagPend then + NextToken + else + if FCurToken in (EndTokens + [IpHtmlTagP, IpHtmltagTABLE]) then + else + if FlagErrors then + ReportExpectedToken(IpHtmlTagPend); +end; + +procedure TIpHtmlParser.ParsePhraseElement(AParent: TIpHtmlNode; + StartToken, EndToken: TIpHtmlToken; const EndTokens: TIpHtmlTokenSet); +var + curPhrase: TIpHtmlNodePhrase; +begin + curPhrase := TIpHtmlNodePhrase.Create(AParent); + case StartToken of + IpHtmlTagEM : + curPhrase.Style := hpsEM; + IpHtmlTagSTRONG : + curPhrase.Style := hpsSTRONG; + IpHtmlTagDFN : + curPhrase.Style := hpsDFN; + IpHtmlTagCODE : + curPhrase.Style := hpsCODE; + IpHtmlTagSAMP : + curPhrase.Style := hpsSAMP; + IpHtmlTagKBD : + curPhrase.Style := hpsKBD; + IpHtmlTagVAR : + curPhrase.Style := hpsVAR; + IpHtmlTagCITE : + curPhrase.Style := hpsCITE; + IpHtmlTagABBR : + curPhrase.Style := hpsABBR; + IpHtmlTagACRONYM : + curPhrase.Style := hpsACRONYM; + end; + curPhrase.ParseBaseProps(FOwner); + NextToken; // this can not be before previous line, as NextToken resets properties + ParseBodyText(curPhrase, [EndToken] + EndTokens); + if FCurToken = EndToken then + NextToken + else + if FCurToken in EndTokens then + // + else + if FlagErrors then + ReportExpectedToken(EndToken); +end; + +function TIpHtmlParser.ParsePixels(const AttrNameSet: TIpHtmlAttributesSet; + const ADefault: string): TIpHtmlPixels; +var + S: string; + n, Err: Integer; +begin + Result := TIpHtmlPixels.Create; + S := FindAttribute(AttrNameSet); + if (S = '') then + S := ADefault; + + if S = '' then + Result.PixelsType := hpUndefined + else begin + Result.PixelsType := hpAbsolute; + val(S, n, Err); + Result.Value := n; + if (Err <> 0) or (Result.Value < 0) then begin + if FlagErrors then + ReportError(SHtmlInvInt) + else + Result.Value := 0; + end; + end; +end; + +procedure TIpHtmlParser.ParsePre(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + curContainer: TIpHtmlNodePRE; +begin + curContainer := TIpHtmlNodePRE.Create(AParent); + curContainer.ParseBaseProps(FOwner); + + Inc(FInPre); + NextToken; + ParseBodyText(curContainer, EndTokens + [IpHtmlTagPREend]); + Dec(FInPre); + + EnsureClosure(IpHtmlTagPREend, EndTokens); +end; + +procedure TIpHtmlParser.ParseQ(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + BQ: TIpHtmlNodeQ; +begin + BQ:= TIpHtmlNodeQ.Create(AParent); + BQ.ParseBaseProps(FOwner); + NextToken; + ParseBodyText(BQ, EndTokens + [IpHtmlTagQend]); + EnsureClosure(IpHtmlTagQend, EndTokens); +end; + +function TIpHtmlParser.ParseRelSize: TIpHtmlRelSize; +var + S: string; + i, Err: Integer; +begin + Result := TIpHtmlRelSize.Create; + Result.SizeType := hrsUnspecified; + S := FindAttribute(htmlAttrSIZE); + if Length(S) = 0 then + Exit; {S := Default;} + + Result.Value := 0; + if (Length(S) > 1) and (S[1] = '+') then begin + Result.SizeType := hrsRelative; + Delete(S, 1, 1); + end else + if (Length(S) > 1) and (S[1] = '-') then begin + Result.SizeType := hrsRelative; + end else + Result.SizeType := hrsAbsolute; + + Val(S, i, Err); + Result.Value := i; + if Err <> 0 then + if FlagErrors then + ReportError(SHtmlInvInt); +end; + +procedure TIpHtmlParser.ParseRight(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + curContainer: TIpHtmlNodeDIV; +begin + curContainer := TIpHtmlNodeDIV.Create(AParent); + with curContainer do + Align := haRight; + NextToken; + ParseBodyText(curContainer, EndTokens + [IpHtmlTagRIGHTend]); + EnsureClosure(IpHtmlTagRIGHTend, EndTokens); +end; + +function TIpHtmlParser.ParseRules(ADefault: TIpHtmlRules): TIpHtmlRules; +var + S: string; +begin + Result := hrNone; + S := UpperCase(FindAttribute(htmlAttrRULES)); + if Length(S) = 0 then + begin + Result := ADefault; + exit; + end; + case S[1] of + 'A': if S = 'ALL' then Result := hrAll; + 'C': if S = 'COLS' then Result := hrCols; + 'G': if S = 'GROUPS' then Result := hrGroups; + 'N': if S = 'NONE' then exit; + 'R': if S = 'ROWS' then Result := hrRows; + else + if FlagErrors then + ReportError(SHtmlInvRule); + end; +end; + +procedure TIpHtmlParser.ParseScript(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +begin + TIpHtmlNodeSCRIPT.Create(AParent); + NextToken; + if FCurToken <> IpHtmlTagScriptEnd then + repeat + NextToken; + until (FCurToken = IpHtmlTagSCRIPTend) or (FCurToken in EndTokens); + EnsureClosure(IpHtmlTagSCRIPTend, EndTokens); +end; + +function TIpHtmlParser.ParseShape: TIpHtmlMapShape; +var + S: string; +begin + Result := hmsDefault; + S := UpperCase(FindAttribute(htmlAttrSHAPE)); + if Length(S) = 0 then + exit; + case S[1] of + 'C': if S = 'CIRCLE' then Result := hmsCircle; + 'D': if S = 'DEFAULT' then exit; + 'P': if (S = 'POLY') or (S = 'POLYGON') then Result := hmsPoly; + 'R': if (S = 'RECT') then Result := hmsRect; + else if FlagErrors then ReportError(SHtmlInvShape); + end; +end; + +procedure TIpHtmlParser.ParseSpan(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + curSPAN: TIpHtmlNodeSPAN; +begin + curSPAN:= TIpHtmlNodeSPAN.Create(AParent); + with curSPAN do begin + Align := ParseAlignment; + ParseBaseProps(FOwner); + end; + NextToken; + ParseBodyText(curSPAN, EndTokens + [IpHtmlTagSPANend]); + EnsureClosure(IpHtmlTagSPANend, EndTokens); +end; + +procedure TIpHtmlParser.ParseStyle(AParent: TIpHtmlNode); +var + curStyle: TIpHtmlNodeSTYLE; +begin + curStyle := TIpHtmlNodeSTYLE.Create(AParent); + with curStyle do begin + Media := FindAttribute(htmlAttrMEDIA); + Title := FindAttribute(htmlAttrTITLE); + Type_ := FindAttribute(htmlAttrTYPE); + end; + NextToken; + if FCurToken <> IpHtmlTagSTYLEend then begin + if (FCurToken = IpHtmlTagText) and (AnsiCompareText(curStyle.Type_, 'text/css')=0) then + ParseStyleSheet(curStyle, GetTokenString); + ParseText(curStyle, [IpHtmlTagSTYLEend]); + end; + if FCurToken = IpHtmlTagSTYLEend then + NextToken + else + if FlagErrors then + ReportExpectedToken(IpHtmlTagSTYLEend); +end; + +procedure TIpHtmlParser.ParseStyleSheet(AParent: TIpHtmlNode; HRef: String); +var + styleStream: TStream; +begin + //debugln(['TIpHtml.ParseStyleSheet ',href,' ',Parent is TIpHtmlNodeHEAD,' ',DbgSName(FDataProvider)]); + styleStream := nil; + + if AParent is TIpHtmlNodeHEAD then begin + if FOwner.DataProvider <> nil then begin + Href := FOwner.DataProvider.BuildURL(FCurURL, HRef); + styleStream := FOwner.DataProvider.DoGetStream(HRef); + end; + end else + if AParent is TIpHtmlNodeSTYLE then + styleStream := TStringStream.Create(Href); + + if styleStream <> nil then + with TCSSReader.Create(styleStream, FOwner.CSS) do begin + ParseCSS; + Free; + styleStream.Free; + end; +end; + +procedure TIpHtmlParser.ParseTABLE(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + curTable: TIpHtmlNodeTABLE; + curCaption: TIpHtmlNodeCAPTION; +begin + curTable := TIpHtmlNodeTABLE.Create(AParent); + with curTable do begin + Align := ParseImageAlignment(hiaBottom); + Width := ParseHyperLength(htmlAttrWIDTH, ''); + Width.OnChange := @WidthChanged; + Border := ParseInteger(htmlAttrBORDER, 0); + CellSpacing := ParseInteger(htmlAttrCELLSPACING, 2); + CellPadding := ParseInteger(htmlAttrCELLPADDING, 2); + BgColor := ColorFromString(FindAttribute(htmlAttrBGCOLOR)); + ParseBaseProps(FOwner); + Summary := FindAttribute(htmlAttrSUMMARY); + Frame := ParseFrameProp(Frame); + Rules := ParseRules(Rules); + end; + + repeat + NextToken; + until FCurToken in + [IpHtmlTagCAPTION, IpHtmlTagCOLGROUP, IpHtmlTagTHEAD, IpHtmlTagTFOOT, + IpHtmlTagTBODY, IpHtmlTagTR, IpHtmlTagTABLEend, IpHtmlTagEOF]; + + if FCurToken = IpHtmlTagCAPTION then begin + curCaption := TIpHtmlNodeCAPTION.Create(CurTable); + curCaption.Align := ParseVAlignment2; + curCaption.ParseBaseProps(FOwner); + ParseBodyText(curCaption, [IpHtmlTagCAPTIONend, IpHtmlTagTABLEend, IpHtmlTagTBODY]); + if FCurToken in EndTokens then + else + if FCurToken = IpHtmlTagCAPTIONend then + NextToken + else + if FlagErrors then + ReportExpectedToken(IpHtmlTagCAPTIONend) + else begin + while not (FCurToken in EndTokens + [IpHtmlTagCAPTIONend]) do + NextToken; + if FCurToken = IpHtmlTagCAPTIONend then + NextToken; + end; + curTable.FCaption := curCaption; + end; + ParseColGroup(curTable); + SkipTextTokens; + ParseTableBody( + curTable, + EndTokens + [IpHtmlTagTABLEend] - [IpHtmlTagTR, IpHtmlTagP, IpHtmlTagPend, IpHTMLTagCENTERend, + IpHtmlTagLEFTend, IpHtmlTagRIGHTend, IpHtmlTagBLINKend, IpHtmlTagBLOCKQUOTEend] + ); + SkipTextTokens; + EnsureClosure(IpHtmlTagTABLEend, EndTokens); +end; + +procedure TIpHtmlParser.ParseTableBody(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + curHead: TIpHtmlNodeTHEAD; + curFoot: TIpHtmlNodeTFOOT; + curBody: TIpHtmlNodeTBODY; +begin + if FCurToken = IpHtmlTagTHEAD then begin + curHead := TIpHtmlNodeTHEAD.Create(AParent); + curHead.ParseBaseProps(FOwner); + curHead.Align := ParseCellAlign(haLeft); + curHead.VAlign := ParseVAlignment3; + NextToken; + ParseTableRows( + curHead, + EndTokens + [IpHtmlTagTFOOT, IpHtmlTagTBODY, IpHtmlTagTHEADend] + - [IpHtmlTagTR, IpHtmlTagTH, IpHtmlTagTD] + ); + if FCurToken = IpHtmlTagTHEADend then + NextToken; + end; + if FCurToken = IpHtmlTagTFOOT then begin + curFoot := TIpHtmlNodeTFOOT.Create(AParent); + curFoot.ParseBaseProps(FOwner); + curFoot.Align := ParseCellAlign(haLeft); + curFoot.VAlign := ParseVAlignment3; + NextToken; + ParseTableRows( + curFoot, + EndTokens + [IpHtmlTagTBODY, IpHtmlTagTFOOTend] + - [IpHtmlTagTR, IpHtmlTagTH, IpHtmlTagTD] + ); + if FCurToken = IpHtmlTagTFOOTend then + NextToken; + end; + while not (FCurToken in EndTokens) do begin + case FCurToken of + IpHtmlTagTBODY : + begin + curBody := TIpHtmlNodeTBODY.Create(AParent); + curBody.ParseBaseProps(FOwner); + curBody.Align := ParseCellAlign(haLeft); + curBody.VAlign := ParseVAlignment3; + NextToken; + ParseTableRows( + curBody, + EndTokens + [IpHtmlTagTBODYend] + - [IpHtmlTagTR, IpHtmlTagTH, IpHtmlTagTD, IpHtmlTagTRend] + ); + if FCurToken = IpHtmlTagTBODYend then + NextToken; + end; + IpHtmlTagTR : + begin + curBody := TIpHtmlNodeTBODY.Create(AParent); + ParseTableRows( + curBody, + EndTokens - [IpHtmlTagTR, IpHtmlTagTH, IpHtmlTagTD] + ); + end; + else + Exit; + end; + end; +end; + +procedure TIpHtmlParser.ParseTableRow(AParent: TIpHtmlNode; + const EndTokens : TIpHtmlTokenSet); +var + curHeader: TIpHtmlNodeTH; + curTableCell: TIpHtmlNodeTD; +begin + while not (FCurToken in EndTokens) do begin + case FCurToken of + IpHtmlTagTH : + begin + curHeader := TIpHtmlNodeTH.Create(AParent); + with curHeader do begin + NoWrap := ParseBoolean(htmlAttrNOWRAP); + RowSpan := ParseInteger(htmlAttrROWSPAN, 1); + ColSpan := ParseInteger(htmlAttrCOLSPAN, 1); + ParseBaseProps(FOwner); + Align := ParseCellAlign(haCenter{haDefault}); + VAlign := ParseVAlignment3; + Width := ParseHyperLength(htmlAttrWIDTH, ''); + Width.OnChange := @DimChanged; + Height := ParsePixels(htmlAttrHEIGHT, ''); + {ParseInteger(htmlAttrHEIGHT, -1);} + Height.OnChange := @DimChanged; + BgColor := ColorFromString(FindAttribute(htmlAttrBGCOLOR)); + end; + NextToken; + ParseBodyText( + curHeader, + EndTokens + [IpHtmlTagTH, IpHtmlTagTHend, IpHtmlTagTD] + ); + if FCurToken in [IpHtmlTagTHend, IpHtmlTagTDend] then + NextRealToken; + end; + IpHtmlTagTD : + begin + curTableCell := TIpHtmlNodeTD.Create(AParent); + with curTableCell do begin + NoWrap := ParseBoolean(htmlAttrNOWRAP); + RowSpan := ParseInteger(htmlAttrROWSPAN, 1); + ColSpan := ParseInteger(htmlAttrCOLSPAN, 1); + ParseBaseProps(FOwner); + Align := ParseCellAlign(haDefault); + VAlign := ParseVAlignment3; + Width := ParseHyperLength(htmlAttrWIDTH, ''); + Width.OnChange := @DimChanged; + Height := ParsePixels(htmlAttrHEIGHT, ''); + {ParseInteger(htmlAttrHEIGHT, -1);} + Height.OnChange := @DimChanged; + BgColor := ColorFromString(FindAttribute(htmlAttrBGCOLOR)); + end; + NextToken; + ParseBodyText(curTableCell, EndTokens + [IpHtmlTagTD, IpHtmlTagTDend]); + if FCurToken = IpHtmlTagTDend then + NextRealToken; + end; + else + NextToken; + end; + end; +end; + +procedure TIpHtmlParser.ParseTableRows(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); + + procedure FixupPercentages(CurRow: TIpHtmlNodeTR); + var + i, Pt, P0: Integer; + begin + Pt := 0; + P0 := 0; + for i := 0 to CurRow.ChildCount - 1 do + if CurRow.ChildNode[i] is TIpHtmlNodeTableHeaderOrCell then + case TIpHtmlNodeTableHeaderOrCell(CurRow.ChildNode[i]).Width.LengthType of + hlUndefined : + Inc(P0); + hlPercent : + Inc(Pt, TIpHtmlNodeTableHeaderOrCell(CurRow.ChildNode[i]).Width.LengthValue); + end; + if (Pt > 0) and (Pt < 100) and (P0 > 0) then begin + Pt := (100 - Pt) div P0; + for i := 0 to CurRow.ChildCount - 1 do + if CurRow.ChildNode[i] is TIpHtmlNodeTableHeaderOrCell then + with TIpHtmlNodeTableHeaderOrCell(CurRow.ChildNode[i]).Width do + if LengthType = hlUndefined then begin + LengthType := hlPercent; + LengthValue := Pt; + end; + end; + end; + +var + curRow: TIpHtmlNodeTR; +begin + curRow := nil; + while not (FCurToken in EndTokens) do + case FCurToken of + IpHtmlTagTR: + begin + if curRow <> nil then + FixupPercentages(curRow); + curRow := TIpHtmlNodeTR.Create(AParent); + curRow.ParseBaseProps(FOwner); + curRow.BgColor := ColorFromString(FindAttribute(htmlAttrBGCOLOR)); + curRow.Align := ParseAlignment; + curRow.VAlign := ParseVAlignment; + curRow.LoadAndApplyCSSProps; + NextRealToken; + ParseTableRow( + curRow, + EndTokens + [IpHtmlTagTRend, IpHtmlTagTR] - [IpHtmlTagTH, IpHtmlTagTD] + ); + while FCurToken = IpHtmlTagTRend do + NextToken; + end; + IpHtmlTagTH, + IpHtmlTagTD: + begin + if curRow <> nil then + FixupPercentages(CurRow); + curRow := TIpHtmlNodeTR.Create(AParent); + ParseTableRow( + curRow, + EndTokens + [IpHtmlTagTR] - [IpHtmlTagTH, IpHtmlTagTD] + ); + end; + else + NextToken; + end; + + if curRow <> nil then + FixupPercentages(curRow); +end; + +procedure TIpHtmlParser.ParseText(AParent: TIpHtmlNode; + const EndTokens: TIpHtmlTokenSet); +var + curContainer: TIpHtmlNodeText; +begin + while not (FCurToken in EndTokens) do begin + case FCurToken of + IpHtmlTagEof : + Exit; + IpHtmlTagText : + begin + curContainer := TIpHtmlNodeText.Create(AParent); +// if curContainer=nil then ; + if curContainer <> nil then + begin + curContainer.EscapedText := GetTokenString; + NextToken; + end; + end; + else + NextToken; + end; + end; +end; + +procedure TIpHtmlParser.ParseTitle(AParent: TIpHtmlNode); +var + B: PAnsiChar; +begin + FTitleNode := TIpHtmlNodeTITLE.Create(AParent); + NextToken; + if FCurToken = IpHtmlTagText then begin + GetMem(B, Length(GetTokenString) + 1); + try + TrimFormatting(EscapeToAnsi(GetTokenString), B); + FTitleNode.Title := B; + finally + FreeMem(B); + end; + NextToken; + end; + if FCurToken = IpHtmlTagTITLEend then + NextToken + else + if FlagErrors then + ReportExpectedToken(IpHtmlTagTITLEend); +end; + +function TIpHtmlParser.ParseULStyle(ADefault: TIpHtmlULType): TIpHtmlULType; +var + S: string; +begin + Result := ADefault; + S := UpperCase(FindAttribute(htmlAttrTYPE)); + if Length(S) = 0 then exit; + case S[1] of + 'C': if S = 'CIRCLE' then Result := ulCircle; + 'D': if S = 'DISC' then Result := ulDisc; + 'S': if S = 'SQUARE' then Result := ulSquare; + else + if FlagErrors then + ReportError(SHtmlInvType); + end; +end; + +procedure TIpHtmlParser.ParseUnorderedList(AParent: TIpHtmlNode; + EndToken: TIpHtmlToken; const EndTokens: TIpHtmlTokenSet); +var + newList: TIpHtmlNodeList; +begin + case Pred(EndToken) of + IpHtmlTagDIR: + newList := TIpHtmlNodeDIR.Create(AParent); + IpHtmlTagMENU: + newList := TIpHtmlNodeMENU.Create(AParent); + else + {IpHtmlTagUL : } + newList := TIpHtmlNodeUL.Create(AParent); + end; + + newList.ParseBaseProps(FOwner); + case FListLevel of + 0 : newList.ListType := ParseULStyle(ulDisc); + 1 : newList.ListType := ParseULStyle(ulCircle); + else + newList.ListType := ParseULStyle(ulSquare); + end; + newList.Compact := ParseBoolean(htmlAttrCOMPACT); + + NextToken; + + Inc(FListLevel); + ParseListItems(newList, + EndToken, EndTokens + [EndToken] - [IpHtmlTagP, IpHtmlTagLI], + newList.ListType); + Dec(FListLevel); + + EnsureClosure(EndToken, EndTokens); +end; + +function TIpHtmlParser.ParseVAlignment: TIpHtmlVAlign; +var + S: string; +begin + Result := hvaMiddle; + S := UpperCase(FindAttribute(htmlAttrVALIGN)); + if Length(S) = 0 then + exit; + case S[1] of + 'B': if S = 'BOTTOM' then Result := hvaBottom; + 'C','M': if (S = 'MIDDLE') or (S = 'CENTER') then exit; + 'T': if S = 'TOP' then Result := hvaTop; + else + if FlagErrors then + ReportError(SHtmlInvAlign); + end; +end; + +function TIpHtmlParser.ParseVAlignment2: TIpHtmlVAlignment2; +var + S: string; +begin + Result := hva2Top; + S := UpperCase(FindAttribute(htmlAttrALIGN)); + if Length(S) = 0 then + exit; + case S[1] of + 'B': if S = 'BOTTOM' then Result := hva2Bottom; + 'L': if S = 'LEFT' then Result := hva2Left; + 'R': if S = 'RIGHT' then Result := hva2Right; + 'T': if (S = 'TOP') then exit; + else + if FlagErrors then + ReportError(SHtmlInvAlign); + end; +end; + +function TIpHtmlParser.ParseVAlignment3: TIpHtmlVAlign3; +var + S : string; +begin + Result := hva3Middle; + S := UpperCase(FindAttribute(htmlAttrVALIGN)); + if Length(S) = 0 then + begin + Result := hva3Default; + exit; + end; + + case S[1] of + 'B': + if S = 'BOTTOM' then + Result := hva3Bottom + else if S = 'BASELINE' then + Result := hva3Baseline; + 'C','M': + if (S = 'MIDDLE') or (S = 'CENTER') then + exit; + 'T': + if (S = 'TOP') then + Result := hva3Top; + else + if FlagErrors then + ReportError(SHtmlInvAlign); + end; +end; + +procedure TIpHtmlParser.PutChar(Ch: AnsiChar); +begin + if (FCharSP >= SizeOf(FCharStack)) then + raise EIpHtmlException.Create(SHtmlCharStackOverfl); + FCharStack[FCharSP] := Ch; + Inc(FCharSP); +end; + +procedure TIpHtmlParser.PutToken(AToken: TIpHtmlToken); +begin + if FHaveToken then + raise EIpHtmlException.Create(SHtmlTokenStackOverfl); + FTokenBuffer := AToken; + FHaveToken := True; +end; + +procedure TIpHtmlParser.ReportError(const AErrorMsg: string); +begin + raise Exception.CreateFmt(SHtmlLineError, [AErrorMsg, FLineNumber, FLineOffset]); +end; + +procedure TIpHtmlParser.ReportExpectedError(const AErrorMsg: string); +begin + ReportError(AErrorMsg + SHtmlExp); +end; + +procedure TIpHtmlParser.ReportExpectedToken(const AToken: TIpHtmlToken); +var + n: integer; +begin + for n := Low(IpHtmlTokens) to High(IpHtmlTokens) do + if IpHtmlTokens[n].tk = AToken then + begin + ReportExpectedError(IpHtmlTokens[n].pc); + break; + end; +end; + +procedure TIpHtmlParser.SkipTextTokens; +begin + while FCurToken = IpHtmlTagText do + NextToken; +end; + +end. + diff --git a/components/turbopower_ipro/iphtmlprop.pas b/components/turbopower_ipro/iphtmlprop.pas index 6b0f29205b..898430231b 100644 --- a/components/turbopower_ipro/iphtmlprop.pas +++ b/components/turbopower_ipro/iphtmlprop.pas @@ -1,4 +1,4 @@ -unit iphtmlprop; +unit IpHtmlProp; {$mode objfpc}{$H+} diff --git a/components/turbopower_ipro/iphtmlutils.pas b/components/turbopower_ipro/iphtmlutils.pas new file mode 100644 index 0000000000..aa73f5fc8d --- /dev/null +++ b/components/turbopower_ipro/iphtmlutils.pas @@ -0,0 +1,592 @@ +unit IpHtmlUtils; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Graphics, + IpHtmlProp; + +const + ShyChar = #1; {character used to represent soft-hyphen in strings} + NbspChar = #2; {character used to represent no-break space in strings} + NAnchorChar = #3 ; {character used to represent an Anchor } + NbspUtf8 = #194#160; {utf8 code of no-break space character} + LF = #10; + CR = #13; + +function ColorFromString(S: String): TColor; +function TryColorFromString(S: String; out AColor: TColor; out AErrMsg: String): Boolean; + +function GetAlignmentForStr(S: string; ADefault: TIpHtmlAlign = haDefault): TIpHtmlAlign; + +function EscapeToAnsi(const S: string): string; +//procedure TrimFormatting(const S: string; Target: PAnsiChar; PreFormatted: Boolean = False); + +implementation + +uses + Translations, LazUTF8, + IpConst,IpUtils; + +const + htmlNamedColors: array[0..140] of record + s: string; + c: TColor; + end = ( // alphabetically ordered + (s:'ALICEBLUE'; c:$FFF8F0), + (s:'ANTIQUEWHITE'; c:$D7EBFA), + (s:'AQUA'; c: $FFFF00), + (s:'AQUAMARINE'; c:$D4FF7F), + (s:'AZURE'; c:$FFFFF0), + (s:'BEIGE'; c:$DCF5F5), + (s:'BISQUE'; c:$C4E4FF), + (s:'BLACK'; c:clBlack), + (s:'BLANCHEDALMOND'; c:$CDEBFF), + (s:'BLUE'; c:$FF0000), + (s:'BLUEVIOLET'; c:$E22B8A), + (s:'BROWN'; c:$2A2AA5), + (s:'BURLYWOOD'; c:$87B8DE), + (s:'CADETBLUE'; c:$A09E5F), + (s:'CHARTREUSE'; c:$00FF7F), + (s:'CHOCOLATE'; c:$1E69D2), + (s:'CORAL'; c:$507FFF), + (s:'CORNFLOWERBLUE'; c:$ED9564), + (s:'CORNSILK'; c:$DCF8FF), + (s:'CRIMSON'; c:$3C14DC), + (s:'CYAN'; c: $FFFF00), + (s:'DARKBLUE'; c:$8B0000), + (s:'DARKCYAN'; c:$8B8B00), + (s:'DARKGOLDENROD'; c:$0B86B8), + (s:'DARKGRAY'; c:$A9A9A9), + (s:'DARKGREEN'; c:$006400), + (s:'DARKKHAKI'; c:$6BB7BD), + (s:'DARKMAGENTA'; c:$8B008B), + (s:'DARKOLIVEGREEN'; c:$2F6B55), + (s:'DARKORANGE'; c:$008CFF), + (s:'DARKORCHID'; c:$CC3299), + (s:'DARKRED'; c:$00008B), + (s:'DARKSALMON'; c:$7A96E9), + (s:'DARKSEAGREEN'; c:$8FBC8F), + (s:'DARKSLATEBLUE' ; c:$8B3D48), + (s:'DARKSLATEGRAY'; c:$4F4F2F), + (s:'DARKTURQUOISE'; c:$D1CE00), + (s:'DARKVIOLET'; c:$D30094), + (s:'DARKYELLOW'; c:$008080), + (s:'DEEPPINK'; c:$9314FF), + (s:'DEEPSKYBLUE'; c:$FFBF00), + (s:'DIMGRAY'; c:$696969), + (s:'DODGERBLUE'; c:$FF901E), + (s:'FIREBRICK'; c:$2222B2), + (s:'FLORALWHITE'; c:$F0FAFF), + (s:'FORESTGREEN'; c:$228B22), + (s:'FUCHSIA'; c:$FF00FF), + (s:'GAINSBORO'; c:$DCDCDC), + (s:'GHOSTWHITE'; c:$FFF8F8), + (s:'GOLD'; c:$00D7FF), + (s:'GOLDENROD'; c:$20A5DA), + (s:'GRAY'; c:$808080), + (s:'GREEN'; c:$008000), + (s:'GREENYELLOW'; c:$2FFFAD), + (s:'HONEYDEW'; c:$F0FFF0), + (s:'HOTPINK'; c:$B469FF), + (s:'INDIANRED'; c:$5C5CCD), + (s:'INDIGO'; c:$82004B), + (s:'IVORY'; c:$F0FFFF), + (s:'KHAKI'; c:$8CE6F0), + (s:'LAVENDER'; c:$FAE6E6), + (s:'LAVENDERBLUSH'; c:$F5F0FF), + (s:'LAWNGREEN'; c:$00FC7C), + (s:'LEMONCHIFFON'; c:$CDFAFF), + (s:'LIGHTBLUE'; c:$E6D8AD), + (s:'LIGHTCORAL'; c:$8080F0), + (s:'LIGHTCYAN'; c:$FFFFE0), + (s:'LIGHTGOLDENRODYELLOW'; c:$D2FAFA), + (s:'LIGHTGREEN'; c:$90EE90), + (s:'LIGHTGREY'; c:$D3D3D3), + (s:'LIGHTPINK'; c:$C1B6FF), + (s:'LIGHTSALMON'; c:$7AA0FF), + (s:'LIGHTSEAGREEN'; c:$AAB220), + (s:'LIGHTSKYBLUE'; c:$FACE87), + (s:'LIGHTSLATEGRAY'; c:$998877), + (s:'LIGHTSTEELBLUE'; c:$DEC4B0), + (s:'LIGHTYELLOW'; c:$E0FFFF), + (s:'LIME'; c:$00FF00), + (s:'LIMEGREEN'; c:$32CD32), + (s:'LINEN'; c:$E6F0FA), + (s:'MAGENTA'; c:$FF00FF), + (s:'MAROON'; c:$000080), + (s:'MEDIUMAQUAMARINE'; c:$AACD66), + (s:'MEDIUMBLUE'; c:$CD0000), + (s:'MEDIUMORCHID'; c:$D355BA), + (s:'MEDIUMPURPLE'; c:$DB7093), + (s:'MEDIUMSEAGREEN'; c:$71B33C), + (s:'MEDIUMSLATEBLUE'; c:$EE687B), + (s:'MEDIUMSPRINGGREEN'; c:$9AFA00), + (s:'MEDIUMTURQUOISE'; c:$CCD148), + (s:'MEDIUMVIOLETRED'; c:$8515C7), + (s:'MIDNIGHTBLUE'; c:$701919), + (s:'MINTCREAM'; c:$FAFFF5), + (s:'MISTYROSE'; c:$E1E4FF), + (s:'MOCCASIN'; c:$B5E4FF), + (s:'NAVAJOWHITE'; c:$ADDEFF), + (s:'NAVY'; c:$800000), + (s:'OLDLACE'; c:$E6F5FD), + (s:'OLIVE'; c:$008080), + (s:'OLIVEDRAB'; c:$238E6B), + (s:'ORANGE'; c:$00A5FF), + (s:'ORANGERED'; c:$0045FF), + (s:'ORCHID'; c:$D670DA), + (s:'PALEGOLDENROD'; c:$AAE8EE), + (s:'PALEGREEN'; c:$98FB98), + (s:'PALETURQUOISE'; c:$EEEEAF), + (s:'PALEVIOLETRED'; c:$9370DB), + (s:'PAPAYAWHIP'; c:$D5EFFF), + (s:'PEACHPUFF'; c:$B9DAFF), + (s:'PERU'; c:$3F85CD), + (s:'PINK'; c:$CBC0FF), + (s:'PLUM'; c:$DDA0DD), + (s:'POWDERBLUE'; c:$E6E0B0), + (s:'PURPLE'; c:$800080), + (s:'RED'; c:$0000FF), + (s:'ROSYBROWN'; c:$8F8FBC), + (s:'ROYALBLUE'; c:$901604), + (s:'SADDLEBROWN'; c:$13458B), + (s:'SALMON'; c:$7280FA), + (s:'SANDYBROWN'; c:$60A4F4), + (s:'SEAGREEN'; c:$578B2E), + (s:'SEASHELL'; c:$EEF5FF), + (s:'SIENNA'; c:$2D52A0), + (s:'SILVER'; c:$C0C0C0), + (s:'SKYBLUE'; c:$EBCE87), + (s:'SLATEBLUE'; c:$CD5A6A), + (s:'SLATEGRAY'; c:$908070), + (s:'SNOW'; c:$FAFAFF), + (s:'SPRINGGREEN'; c:$7FFF00), + (s:'STEELBLUE'; c:$B48246), + (s:'TAN'; c:$8CB4D2), + (s:'TEAL'; c:$808000), + (s:'THISTLE'; c:$D8BFD8), + (s:'TOMATO'; c:$4763FF), + (s:'TURQUOISE'; c:$D0E040), + (s:'VIOLET'; c:$EE82EE), + (s:'WHEAT'; c:$B3DEF5), + (s:'WHITE'; c:$FFFFFF), + (s:'WHITESMOKE'; c:$F5F5F5), + (s:'YELLOW'; c:$00FFFF), + (s:'YELLOWGREEN'; c:$32CD9A) + ); + +function BinSearchNamedColor(const AColorStr: string; var AColor: TColor): boolean; +var + First: Integer; + Last: Integer; + Pivot: Integer; +begin + First := Low(htmlNamedColors); //Sets the first item of the range + Last := High(htmlNamedColors); //Sets the last item of the range + Result := False; //Initializes the Found flag (Not found yet) + + //If First > Last then the searched item doesn't exist + //If the item is found the loop will stop + while (First <= Last) {and (not Result)} do + begin + //Gets the middle of the selected range + Pivot := (First + Last) div 2; + //Compares the String in the middle with the searched one + if htmlNamedColors[Pivot].s = AColorStr then + begin + Result := True; + AColor := htmlNamedColors[Pivot].c; + exit; + end + //If the Item in the middle has a bigger value than + //the searched item, then select the first half + else if htmlNamedColors[Pivot].s > AColorStr then + Last := Pivot - 1 + //else select the second half + else + First := Pivot + 1; + end; +end; + +function TryColorFromString(S: String; out AColor: TColor; out AErrMsg: String): Boolean; +var + R, G, B, Err: Integer; +begin + Result := false; + + AColor := clNone; + if S = '' then + begin + Result := true; + Exit; + end; + + S := UpperCase(S); + if S[1] = '#' then + begin + if Length(S) <> 7 then + begin + AErrMsg := SHtmlInvColor + S; + Result := false; + end + else begin + val('$'+Copy(S,2,2), R, Err); + if Err <> 0 then + R := 255; + val('$'+Copy(S,4,2), G, Err); + if Err <> 0 then + G := 255; + val('$'+Copy(S,6,2), B, Err); + if Err <> 0 then + B := 255; + AColor := RGBToColor(R, G, B); + Result := true; + end; + end else + if BinSearchNamedColor(S, AColor) then + begin + Result := true; + exit; + end else + if Length(S) = 6 then + try + val('$'+Copy(S,1,2), R, Err); + if Err <> 0 then + R := 255; + val('$'+Copy(S,3,2), G, Err); + if Err <> 0 then + G := 255; + val('$'+Copy(S,5,2), B, Err); + if Err <> 0 then + B := 255; + AColor := RGBToColor(R, G, B); + Result := true; + except + AErrMsg := SHtmlInvColor + S; + end; +end; + +function ColorFromString(S: String): TColor; +var + msg: String; +begin + if not TryColorFromString(S, Result, msg) then + Result := clNone; +end; + +function GetAlignmentForStr(S: string; + ADefault: TIpHtmlAlign = haDefault): TIpHtmlAlign; +begin + S := UpperCase(S); + if Length(S) = 0 then + begin + Result := ADefault; + exit; + end; + + case S[1] of + 'C','M': + if S = 'CHAR' then + Result := haChar + else if (S = 'CENTER') or (S = 'MIDDLE') then + Result := haCenter; + 'J': + if S = 'JUSTIFY' then Result := haJustify; + 'L': + if (S = 'LEFT') then Result := haLeft; + 'R': + if S = 'RIGHT' then Result := haRight; + else + Result := ADefault; + end; +end; + +const + CodeCount = 126; + + {Sorted by Size where size is Length(Name). + Make sure you respect this when adding new items} + Codes: array[0..Pred(CodeCount)] of record + Size: Integer; + Name: String; + Value: String; + ValueUtf8: String; //UTF8 DiBo33 + end = ( + (Size: 2; Name: 'gt'; Value: '>'; ValueUtf8: #$3E), + (Size: 2; Name: 'lt'; Value: '<'; ValueUtf8: #$3C), + (Size: 3; Name: 'amp'; Value: '&'; ValueUtf8: #$26), + (Size: 3; Name: 'deg'; Value: #176; ValueUtf8: #$C2#$B0), + (Size: 3; Name: 'ETH'; Value: #208; ValueUtf8: #$C3#$90), + (Size: 3; Name: 'eth'; Value: #240; ValueUtf8: #$C3#$B0), + (Size: 3; Name: 'not'; Value: #172; ValueUtf8: #$C2#$AC), + (Size: 3; Name: 'reg'; Value: #174; ValueUtf8: #$C2#$AE), + (Size: 3; Name: 'shy'; Value: ShyChar; ValueUtf8: ShyChar), + (Size: 3; Name: 'uml'; Value: #168; ValueUtf8: #$C2#$A8), + (Size: 3; Name: 'yen'; Value: #165; ValueUtf8: #$C2#$A5), + (Size: 4; Name: 'Auml'; Value: #196; ValueUtf8: #$C3#$84), + (Size: 4; Name: 'auml'; Value: #228; ValueUtf8: #$C3#$A4), + (Size: 4; Name: 'bull'; Value: #149; ValueUtf8: #$E2#$80#$A2), + (Size: 4; Name: 'cent'; Value: #162; ValueUtf8: #$C2#$A2), + (Size: 4; Name: 'circ'; Value: '^'; ValueUtf8: #$5E), + (Size: 4; Name: 'copy'; Value: #169; ValueUtf8: #$C2#$A9), + (Size: 4; Name: 'Euml'; Value: #203; ValueUtf8: #$C3#$8B), + (Size: 4; Name: 'euml'; Value: #235; ValueUtf8: #$C3#$AB), + (Size: 4; Name: 'euro'; Value: #128; ValueUtf8: #$E2#$82#$AC), + (Size: 4; Name: 'fnof'; Value: #131; ValueUtf8: #$C6#$92), + (Size: 4; Name: 'Iuml'; Value: #207; ValueUtf8: #$C3#$8F), + (Size: 4; Name: 'iuml'; Value: #239; ValueUtf8: #$C3#$AF), + (Size: 4; Name: 'macr'; Value: #175; ValueUtf8: #$C2#$AF), + (Size: 4; Name: 'nbsp'; Value: NbspChar; ValueUtf8: NbspChar), + (Size: 4; Name: 'ordf'; Value: #170; ValueUtf8: #$C2#$AA), + (Size: 4; Name: 'ordm'; Value: #186; ValueUtf8: #$C2#$BA), + (Size: 4; Name: 'Ouml'; Value: #214; ValueUtf8: #$C3#$96), + (Size: 4; Name: 'ouml'; Value: #246; ValueUtf8: #$C3#$B6), + (Size: 4; Name: 'para'; Value: #182; ValueUtf8: #$C2#$B6), + (Size: 4; Name: 'quot'; Value: '"'; ValueUtf8: #$22), + (Size: 4; Name: 'sect'; Value: #167; ValueUtf8: #$C2#$A7), + (Size: 4; Name: 'sup1'; Value: #185; ValueUtf8: #$C2#$B9), + (Size: 4; Name: 'sup2'; Value: #178; ValueUtf8: #$C2#$B2), + (Size: 4; Name: 'sup3'; Value: #179; ValueUtf8: #$C2#$B3), + (Size: 4; Name: 'Uuml'; Value: #220; ValueUtf8: #$C3#$9C), + (Size: 4; Name: 'uuml'; Value: #252; ValueUtf8: #$C3#$BC), + (Size: 4; Name: 'Yuml'; Value: #159; ValueUtf8: #$C5#$B8), + (Size: 4; Name: 'yuml'; Value: #255; ValueUtf8: #$C3#$BF), + (Size: 5; Name: 'Acirc'; Value: #194; ValueUtf8: #$C3#$82), + (Size: 5; Name: 'acirc'; Value: #226; ValueUtf8: #$C3#$A2), + (Size: 5; Name: 'acute'; Value: #180; ValueUtf8: #$C2#$B4), + (Size: 5; Name: 'AElig'; Value: #198; ValueUtf8: #$C3#$86), + (Size: 5; Name: 'aelig'; Value: #230; ValueUtf8: #$C3#$A6), + (Size: 5; Name: 'Aring'; Value: #197; ValueUtf8: #$C3#$85), + (Size: 5; Name: 'aring'; Value: #229; ValueUtf8: #$C3#$A5), + (Size: 5; Name: 'cedil'; Value: #184; ValueUtf8: #$C2#$B8), + (Size: 5; Name: 'Ecirc'; Value: #202; ValueUtf8: #$C3#$8A), + (Size: 5; Name: 'ecirc'; Value: #234; ValueUtf8: #$C3#$AA), + (Size: 5; Name: 'frasl'; Value: '/'; ValueUtf8: #$2F), + (Size: 5; Name: 'Icirc'; Value: #206; ValueUtf8: #$C3#$8E), + (Size: 5; Name: 'icirc'; Value: #238; ValueUtf8: #$C3#$AE), + (Size: 5; Name: 'iexcl'; Value: #161; ValueUtf8: #$C2#$A1), + (Size: 5; Name: 'laquo'; Value: #171; ValueUtf8: #$C2#$AB), + (Size: 5; Name: 'ldquo'; Value: #147; ValueUtf8: #$E2#$80#$9C), + (Size: 5; Name: 'lsquo'; Value: #145; ValueUtf8: #$E2#$80#$98), + (Size: 5; Name: 'mdash'; Value: #151; ValueUtf8: #$E2#$80#$94), + (Size: 5; Name: 'micro'; Value: #181; ValueUtf8: #$C2#$B5), + (Size: 5; Name: 'minus'; Value: '-'; ValueUtf8: #$2D), + (Size: 5; Name: 'ndash'; Value: #150; ValueUtf8: #$E2#$80#$93), + (Size: 5; Name: 'Ocirc'; Value: #212; ValueUtf8: #$C3#$94), + (Size: 5; Name: 'ocirc'; Value: #244; ValueUtf8: #$C3#$B4), + (Size: 5; Name: 'OElig'; Value: #140; ValueUtf8: #$C5#$92), + (Size: 5; Name: 'oelig'; Value: #156; ValueUtf8: #$C5#$93), + (Size: 5; Name: 'pound'; Value: #163; ValueUtf8: #$C2#$A3), + (Size: 5; Name: 'raquo'; Value: #187; ValueUtf8: #$C2#$BB), + (Size: 5; Name: 'rdquo'; Value: #148; ValueUtf8: #$E2#$80#$9D), + (Size: 5; Name: 'rsquo'; Value: #146; ValueUtf8: #$E2#$80#$99), + (Size: 5; Name: 'szlig'; Value: #223; ValueUtf8: #$C3#$9F), + (Size: 5; Name: 'THORN'; Value: #222; ValueUtf8: #$C3#$9E), + (Size: 5; Name: 'thorn'; Value: #254; ValueUtf8: #$C3#$BE), + (Size: 5; Name: 'tilde'; Value: '~'; ValueUtf8: #$7E), + (Size: 5; Name: 'times'; Value: #215; ValueUtf8: #$C3#$97), + (Size: 5; Name: 'trade'; Value: #153; ValueUtf8: #$E2#$84#$A2), + (Size: 5; Name: 'Ucirc'; Value: #219; ValueUtf8: #$C3#$9B), + (Size: 5; Name: 'ucirc'; Value: #251; ValueUtf8: #$C3#$BB), + (Size: 6; Name: 'Aacute'; Value: #193; ValueUtf8: #$C3#$81), + (Size: 6; Name: 'aacute'; Value: #225; ValueUtf8: #$C3#$A1), + (Size: 6; Name: 'Agrave'; Value: #192; ValueUtf8: #$C3#$80), + (Size: 6; Name: 'agrave'; Value: #224; ValueUtf8: #$C3#$A0), + (Size: 6; Name: 'Atilde'; Value: #195; ValueUtf8: #$C3#$83), + (Size: 6; Name: 'atilde'; Value: #227; ValueUtf8: #$C3#$A3), + (Size: 6; Name: 'brvbar'; Value: #166; ValueUtf8: #$C2#$A6), + (Size: 6; Name: 'Ccedil'; Value: #199; ValueUtf8: #$C3#$87), + (Size: 6; Name: 'ccedil'; Value: #231; ValueUtf8: #$C3#$A7), + (Size: 6; Name: 'curren'; Value: #164; ValueUtf8: #$C2#$A4), + (Size: 6; Name: 'dagger'; Value: #134; ValueUtf8: #$E2#$80#$A0), + (Size: 6; Name: 'Dagger'; Value: #135; ValueUtf8: #$E2#$80#$A1), + (Size: 6; Name: 'divide'; Value: #247; ValueUtf8: #$C3#$B7), + (Size: 6; Name: 'Eacute'; Value: #201; ValueUtf8: #$C3#$89), + (Size: 6; Name: 'eacute'; Value: #233; ValueUtf8: #$C3#$A9), + (Size: 6; Name: 'Egrave'; Value: #200; ValueUtf8: #$C3#$88), + (Size: 6; Name: 'egrave'; Value: #232; ValueUtf8: #$C3#$A8), + (Size: 6; Name: 'frac12'; Value: #189; ValueUtf8: #$C2#$BD), + (Size: 6; Name: 'frac14'; Value: #188; ValueUtf8: #$C2#$BC), + (Size: 6; Name: 'frac34'; Value: #190; ValueUtf8: #$C2#$BE), + (Size: 6; Name: 'hellip'; Value: #133; ValueUtf8: #$E2#$80#$A6), + (Size: 6; Name: 'Iacute'; Value: #205; ValueUtf8: #$C3#$8D), + (Size: 6; Name: 'iacute'; Value: #237; ValueUtf8: #$C3#$AD), + (Size: 6; Name: 'Igrave'; Value: #204; ValueUtf8: #$C3#$8C), + (Size: 6; Name: 'igrave'; Value: #236; ValueUtf8: #$C3#$AC), + (Size: 6; Name: 'iquest'; Value: #191; ValueUtf8: #$C2#$BF), + (Size: 6; Name: 'lsaquo'; Value: #139; ValueUtf8: #$E2#$80#$B9), + (Size: 6; Name: 'middot'; Value: #183; ValueUtf8: #$C2#$B7), + (Size: 6; Name: 'Ntilde'; Value: #209; ValueUtf8: #$C3#$91), + (Size: 6; Name: 'ntilde'; Value: #241; ValueUtf8: #$C3#$B1), + (Size: 6; Name: 'Oacute'; Value: #211; ValueUtf8: #$C3#$93), + (Size: 6; Name: 'oacute'; Value: #243; ValueUtf8: #$C3#$B3), + (Size: 6; Name: 'Ograve'; Value: #210; ValueUtf8: #$C3#$92), + (Size: 6; Name: 'ograve'; Value: #242; ValueUtf8: #$C3#$B2), + (Size: 6; Name: 'Oslash'; Value: #216; ValueUtf8: #$C3#$98), + (Size: 6; Name: 'oslash'; Value: #248; ValueUtf8: #$C3#$B8), + (Size: 6; Name: 'Otilde'; Value: #213; ValueUtf8: #$C3#$95), + (Size: 6; Name: 'otilde'; Value: #245; ValueUtf8: #$C3#$B5), + (Size: 6; Name: 'permil'; Value: #137; ValueUtf8: #$E2#$80#$B0), + (Size: 6; Name: 'plusmn'; Value: #177; ValueUtf8: #$C2#$B1), + (Size: 6; Name: 'rsaquo'; Value: #155; ValueUtf8: #$E2#$80#$BA), + (Size: 6; Name: 'Scaron'; Value: #138; ValueUtf8: #$C5#$A0), + (Size: 6; Name: 'scaron'; Value: #154; ValueUtf8: #$C5#$A1), + (Size: 6; Name: 'Uacute'; Value: #218; ValueUtf8: #$C3#$9A), + (Size: 6; Name: 'uacute'; Value: #250; ValueUtf8: #$C3#$BA), + (Size: 6; Name: 'Ugrave'; Value: #217; ValueUtf8: #$C3#$99), + (Size: 6; Name: 'ugrave'; Value: #249; ValueUtf8: #$C3#$B9), + (Size: 6; Name: 'Yacute'; Value: #221; ValueUtf8: #$C3#$9D), + (Size: 6; Name: 'yacute'; Value: #253; ValueUtf8: #$C3#$BD), + (Size: 6; Name: 'xxxxxx'; Value: NAnchorChar; ValueUtf8: NAnchorChar) + ); + +function ParseConstant(const S: string; OnUtf8: boolean = false): string; +var + Error: Integer; + Index1: Integer; + Index2: Integer; + Size1: Integer; + Found: Boolean; +begin {'Complete boolean eval' must be off} + Result := ' '; + Size1 := Length(S); + if Size1 = 0 then Exit; + if (S[1] in ['$', '0'..'9']) then + begin + Val(S, Index1, Error); + if (Error = 0) then + begin + if not OnUTF8 and (Index1 >= 32) and (Index1 <= 255) then + Result := Chr(Index1) + else + begin + Result := UnicodeToUTF8(Index1); + if Result = NbspUTF8 then Result := NbspChar; + end; + end; + end else + begin + Index1 := 0; + repeat + if Size1 = Codes[Index1].Size then + begin + Found := True; + Index2 := 1; + while Index2 <= Size1 do + begin + if S[Index2] <> Codes[Index1].Name[Index2] then + begin + Found := False; + Break; + end; + Inc(Index2); + end; + if Found then + begin + if OnUtf8 then + Result := Codes[Index1].ValueUTF8 + else + Result := Codes[Index1].Value; + Break; + end; + end; + Inc(Index1); + until (Index1 >= CodeCount) or (Codes[Index1].Size > Size1); + end; +end; + +{- returns the string with & escapes expanded} +procedure ExpandEscapes(var S: string); +var + i, j : Integer; + Co : string; + Ch : AnsiChar; + St : string; +begin + i := Length(S); + while i > 0 do begin + if S[i] = '&' then begin + j := i; + while (j < length(S)) and not (S[j] in [';', ' ']) do + Inc(j); + Co := copy(S, i + 1, j - i - 1); + if Co <> '' then begin + if Co[1] = '#' then begin + Delete(Co, 1, 1); + if UpCase(Co[1]) = 'X' then begin + Delete(Co, 1, 1); + Insert('$', Co, 1); + end; + end; + Delete(S, i, j - i + 1); + if SystemCharSetIsUTF8 then begin + St := ParseConstant(Co, true); + Insert(St, S, i) + end else begin + Ch := ParseConstant(Co)[1]; + Insert(Ch, S, i); + end; + end; + end; + Dec(i); + end; +end; + +function EscapeToAnsi(const S: string): string; +var + P : Integer; +begin + Result := S; + P := CharPos('&', S); + if P <> 0 then + ExpandEscapes(Result); +end; + (* +procedure TrimFormatting(const S: string; Target: PAnsiChar; PreFormatted: Boolean = False); +var + r, w: Integer; + + procedure CopyChar(ch: AnsiChar); + begin + Target[w] := ch; + Inc(w); + end; + +begin + r := 1; + w := 0; + while r <= Length(S) do begin + case S[r] of + #0..#8, #11..#12, #14..#31 : + ; + #9 : + if PreFormatted then + CopyChar(' '); + #13 : + if PreFormatted then + CopyChar(LF); + #10 : + if PreFormatted then begin + if (w = 0) or (Target[w-1] <> LF) then + CopyChar(LF); + end + else begin + if w > 1 then + CopyChar(' '); + end; + ' ' : + if PreFormatted or (w = 0) or (Target[w-1] <> ' ') then + CopyChar(' '); + else + CopyChar(S[r]); + end; + Inc(r); + end; + Target[w] := #0; +end; *) + +end. + diff --git a/components/turbopower_ipro/test_cases/ipro_tests.pas b/components/turbopower_ipro/test_cases/ipro_tests.pas index f5237b43eb..e1fdbc4de6 100644 --- a/components/turbopower_ipro/test_cases/ipro_tests.pas +++ b/components/turbopower_ipro/test_cases/ipro_tests.pas @@ -273,6 +273,54 @@ const '' + LE + ''; +//------------------------------------------------------------------------------ +// CSS +//------------------------------------------------------------------------------ +const + HTMLCommentInCSS_title = + 'HTML comment in CSS section'; + HTMLCommentInCSS_descr = + 'The text must be red.'; + HTMLCommentInCSS_html = + '' + LE + + '' + LE + + ' ' + LE + + '' + LE + + '' + LE + + '

abc

' + LE + + '' + LE + + ''; + +//------------------------------------------------------------------------------ +// Special cases in file structure +//------------------------------------------------------------------------------ +const + NoHtmlTag_title = + 'No tag'; + NoHtmlTag_descr = + 'You should see an ordered list with two items "line 1" and "line 2".'; + NoHtmlTag_html = + '' + LE + + '
    ' + LE + + '
  1. line 1
    2. ' + LE + + '
  2. line 2
    3. ' + LE + + '
' + LE + + ''; + +const + NoBodyTag_title = + 'No tag'; + NoBodyTag_descr = + 'You should see an ordered list with two items "line 1" and "line 2".'; + NoBodyTag_html = + '
    ' + LE + + '
  1. line 1
    2. ' + LE + + '
  2. line 2
    3. ' + LE + + '
'; implementation diff --git a/components/turbopower_ipro/test_cases/iprotest_unit.pas b/components/turbopower_ipro/test_cases/iprotest_unit.pas index 977e7681cf..a22dfeab99 100644 --- a/components/turbopower_ipro/test_cases/iprotest_unit.pas +++ b/components/turbopower_ipro/test_cases/iprotest_unit.pas @@ -139,7 +139,7 @@ end; procedure TForm1.PopulateTests; var - node: TTreeNode; + node, node1: TTreeNode; begin TreeView1.Items.BeginUpdate; try @@ -162,11 +162,22 @@ begin AddTest(node, TextInColoredTableCell_title, TextInColoredTableCell_descr, TextInColoredTableCell_html); node.Expanded := true; - node := TreeView1.Items.AddChild(nil, 'Text alignment'); - AddTest(node, AlignInCell_title, AlignInCell_descr, AlignInCell_html); - AddTest(node, AlignInCellBold_title, AlignInCellBold_descr, AlignInCellBold_html); - AddTest(node, AlignInCell_CSS_title, AlignInCell_CSS_descr, AlignInCell_CSS_html); - AddTest(node, AlignInCellBold_CSS_title, AlignInCellBold_CSS_descr, AlignInCellBold_CSS_html); + node := TreeView1.Items.AddChild(nil, 'Tables'); + node1 := TreeView1.Items.AddChild(node, 'Text alignment'); + AddTest(node1, AlignInCell_title, AlignInCell_descr, AlignInCell_html); + AddTest(node1, AlignInCellBold_title, AlignInCellBold_descr, AlignInCellBold_html); + AddTest(node1, AlignInCell_CSS_title, AlignInCell_CSS_descr, AlignInCell_CSS_html); + AddTest(node1, AlignInCellBold_CSS_title, AlignInCellBold_CSS_descr, AlignInCellBold_CSS_html); + node1.Expanded := true; + node.Expanded := true; + + node := TreeView1.Items.AddChild(nil, 'CSS'); + AddTest(node, HTMLCommentInCSS_title, HTMLCommentInCSS_descr, HTMLCommentInCSS_html); + node.Expanded := true; + + node := TreeView1.Items.AddChild(nil, 'Special cases in file structure'); + AddTest(node, NoHtmlTag_title, NoHtmlTag_descr, NoHtmlTag_html); + AddTest(node, NoBodyTag_title, NoBodyTag_descr, NoBodyTag_html); node.Expanded := true; finally diff --git a/components/turbopower_ipro/turbopoweripro.lpk b/components/turbopower_ipro/turbopoweripro.lpk index 92a555c30b..3b49b01766 100644 --- a/components/turbopower_ipro/turbopoweripro.lpk +++ b/components/turbopower_ipro/turbopoweripro.lpk @@ -25,7 +25,7 @@ - + @@ -98,6 +98,18 @@ + + + + + + + + + + + + diff --git a/components/turbopower_ipro/turbopoweripro.pas b/components/turbopower_ipro/turbopoweripro.pas index 8922d5b5f5..31a173ed21 100644 --- a/components/turbopower_ipro/turbopoweripro.pas +++ b/components/turbopower_ipro/turbopoweripro.pas @@ -10,7 +10,7 @@ interface uses IpAnim, IpConst, Ipfilebroker, Iphttpbroker, IpHtml, IpMsg, IpStrms, IpUtils, IpHtmlTabList, iphtmlprop, ipHtmlBlockLayout, ipHtmlTableLayout, - LazarusPackageIntf; + IpHtmlParser, IpHtmlUtils, IpCSS, LazarusPackageIntf; implementation @@ -24,4 +24,3 @@ end; initialization RegisterPackage('TurboPowerIPro', @Register); end. -