{Version 7.5} {*********************************************************} {* LITEPARS.PAS *} {* Copyright (c) 1995-2002 by *} {* L. David Baldwin *} {* All rights reserved. *} {*********************************************************} {$i LiteCons.inc} { The Parser This module contains the parser which reads thru the document. It divides it into sections storing the pertinent information in Section objects. The document itself is then a TList of section objects. See the LiteSubs unit for the definition of the section objects. Key Variables: Sy: An enumerated type which indicates what the current token is. For example, a value of TextSy would indicate a hunk of text, PSy that a
tag was encountered, etc. LCh: The next character in the stream to be analyzed. In mixed case. Ch: The same character in upper case. LCToken: A string which is associated with the current token. If Sy is TextSy, then LCToken contains the text. Attributes: A list of TAttribute's for tokens such as , , which have attributes. Section: The current section being built. SectionList: The list of sections which form the document. When in a Table, SectionList will contain the list that makes up the current cell. Key Routines: GetCh: Gets the next character from the stream. Fills Ch and LCh. Skips comments. Next: Gets the next token. Fills Sy, LCToken, Attributes. Calls GetCh so the next character after the present token is available. Each part of the parser is responsible for calling Next after it does its thing. } unit LitePars; interface uses {$IFDEF HL_LAZARUS} Classes, SysUtils, LCLType, Messages, GraphType, Graphics, Controls, Dialogs, StdCtrls, LiteUn2, LiteSubs, LiteSbs1; {$ELSE} SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Dialogs, StdCtrls, LiteUn2, LiteSubs, LiteSbs1; {$ENDIF} const MaxStack = 25; FontConv: array[1..7] of integer = (8,10,12,14,18,24,36); PreFontConv: array[1..7] of integer = (7,8,10,12,15,20,30); type LoadStyleType = (lsPrimary, lsInclude); TIncludeType = procedure(Sender: TObject; const Command: string; Params: TStrings; var IString: string) of Object; TSoundType = procedure(Sender: TObject; const SRC: string; Loop: integer; Terminate: boolean) of Object; TMetaType = procedure(Sender: TObject; const HttpEq, Name, Content: string) of Object; SymbSet = Set of Symb; TLastChar = (lcOther, lcCR, lcLF); ThlParser = Class private Sy : Symb; PreFormat: boolean; {set when doing preformat
 text}
    Justify: JustifyType;
    BaseFontSize: integer;
    InScript: boolean;     {when in a ') = 0 then    
      Sy := ScriptEndSy;
    end;

  begin  {already have fresh character loaded here}
  LCToken.Clear;    
  if LCh = EofChar then Sy := EofSy
  else if LCh = ^M then
    begin
    Sy := EolSy;
    GetCh;
    end
  else if LCh = '<' then
     GetTag1
  else
    begin
    Sy := TextSy;
    while (Length(LCToken.S) < 100) and  not (LCh in [^M, '<', EofChar]) do 
      begin
      LCToken.AddChar(LCh, SIndex);  
      GetCh;
      end;
    end;
  end;

begin
try
  if Assigned(AScript) then
    begin
    InScript := True;
    if Attributes.Find(LanguageSy, T) then
      Lang := T.Name
    else Lang := '';
    if Attributes.Find(NameSy, T) then 
      AName := T.Name
    else AName := '';                  

    GetMem(Buffer, Block);
    Pos := 0;
    Size := Block;
    try
      Next1;
      while (Sy <> ScriptEndSy) and (Sy <> EofSy) do
        begin
        if Sy = EolSy then AddText(^M^J)
        else
          AddText(LCToken.S);  
        Next1;
        end;
      AddText(#0);
      ReAllocMem(Buffer, Size);
      AScript(CallingObject, AName, Lang, Buffer);
    except
      FreeMem(Buffer);
      Raise;
      end;
    end
  else
    begin
    repeat
      Next1;
    until Sy in [ScriptEndSy, EofSy];
    end;
finally
  InScript := False;
  end;
end;

{----------------DoCommonSy}
procedure ThlParser.DoCommonSy(Lev: integer);
var
  I: integer;
  TxtArea: TTextAreaFormControlObj;
  FormControl: TFormControlObj;
  T: TAttribute;
  TmpJustify, LastAlign: JustifyType;
  Tmp: string;

  function IncrementFont(Sy: Symb; Pre: boolean): boolean;
  var
    NewSize: integer;

    function GetSizeIndex(Pre: boolean; Size: integer): integer;
    begin
    for Result := 1 to 7 do
      if Pre and (Size = PreFontConv[Result]) then Exit
      else if Size = FontConv[Result] then Exit;
    Result := -1;
    end;

  begin
  Result := False;
  NewSize := GetSizeIndex(Pre, FontStack[StackIndex].NormalSize);
  if (Sy = BigSy) then
    begin
    if (NewSize in [1..6]) then Inc(NewSize);
    end
  else
    if NewSize in [2..7] then Dec(NewSize);   

  if PushNewFont then
    begin
    if Pre then NewSize := PreFontConv[NewSize]
    else NewSize := FontConv[NewSize];
    FontStack[StackIndex].SetNormalSize(MasterList, NewSize);
    Result := True;
    end;
  end;

  function ChangeTheFont(Sy: Symb; Pre: boolean): boolean;
  var
    FaceName: string[50];
    NewColor: TColor;
    NewSize, I, K: integer;
    FontResults: set of (Face, Colr, Siz);
  begin
  FontResults := [];
  NewSize := 0;  {get rid of warning}
  for I := 0 to Attributes.Count-1 do
    with TAttribute(Attributes[I]) do
      case Which of
        SizeSy:
          begin
          if (Length(Name) >= 2) and (Name[1] in ['+', '-']) then
            Value := BaseFontSize + Value;
          NewSize := IntMax(1, IntMin(7, Value)); {limit 1..7}
          if (Sy = BaseFontSy) then BaseFontSize := NewSize;
          Include(FontResults, Siz);
          end;
        ColorSy:
          if (Sy <> BaseFontSy) and GetColor(Name, NewColor) then Include(FontResults, Colr);
        FaceSy:
          if (Sy <> BaseFontSy) and (Name <> '') then
            begin
            FaceName := Name;
            K := Pos(',', FaceName);
            if K > 0 then
              Delete(FaceName, K, 255);
            FaceName := Trim(FaceName);
            if FaceName <> '' then
              Include(FontResults, Face);
            end;
        end;
  Result := False;
  if ((Sy <> BasefontSy) or (SectionList.Count = 0) and
          (SectionList = MasterList)) and  {new font only if at start for Basefont}
       PushNewFont and (FontResults <> []) then
    with FontStack[StackIndex] do
      begin
      if Colr in FontResults then
        Color := NewColor or $2000000;
      if Siz in FontResults then
        begin
        if Pre then NewSize := PreFontConv[NewSize]
        else NewSize := FontConv[NewSize];
        SetNormalSize(MasterList, NewSize);
        end;
      if Face in FontResults then
        Name := FaceName;
      Result := True;
      end;
  end;

  procedure DoPreSy;
  var
    S: TokenObj;    
    Tmp: String;
    Done: boolean;
    I, InitialStackIndex: integer;

    procedure NewSection;
    begin
    Section.AddTokenObj(S, NoBreak);
    S.Clear; 
    SectionList.Add(Section);
    Section := TPreFormated.Create(MasterList, Lev, FontStack[StackIndex],
               CurrentUrlTarget, Left);
    end;

  begin
  S := TokenObj.Create;   
  try
    SectionList.Add(Section);
    PushNewFont;
    InitialStackIndex := StackIndex;   
    with FontStack[StackIndex] do
      begin
      Name := MasterList.PreFontName;
      SetNormalSize(MasterList, 10);
      Fixed := True;
      end;
    Section := TPreformated.Create(MasterList, Lev, FontStack[StackIndex],
               CurrentUrlTarget, Left);
    S.Clear;  
    PreFormat := True;
    Done := False;
    while not Done do
      case Ch of
        '&': begin
             Next;
             S.Concat(LCToken);  
             end;
        '<':
           begin
           Next;
           case Sy of
             PSy, BRSy:
               begin
               NewSection;
               if Ch = ^M then GetCh;
               end;

             PreEndSy, TDEndSy, THEndSy:
               Done := True;

             BSy, ISy, BEndSy, IEndSy, EmSy, EmEndSy, StrongSy, StrongEndSy,
                 USy, UEndSy, CiteSy, CiteEndSy, VarSy, VarEndSy,
                 SSy, SEndSy, StrikeSy, StrikeEndSy:
               begin
               Section.AddTokenObj(S, NoBreak);
               S.Clear;   
               case Sy of
                 BSy, StrongSy:  CurrentStyle := CurrentStyle + [fsBold];
                 BEndSy, StrongEndSy:  CurrentStyle := CurrentStyle - [fsBold];
                 ISy, EmSy, CiteSy, VarSy:  CurrentStyle := CurrentStyle + [fsItalic];
                 IEndSy, EmEndSy,
                   CiteEndSy, VarEndSy:  CurrentStyle := CurrentStyle - [fsItalic];
                 USy:  CurrentStyle := CurrentStyle + [fsUnderline];
                 UEndSy:  CurrentStyle := CurrentStyle - [fsUnderline];
                 SSy, StrikeSy:  CurrentStyle := CurrentStyle + [fsStrikeOut];
                 SEndSy, StrikeEndSy:  CurrentStyle := CurrentStyle - [fsStrikeOut];
                 end;

               TSection(Section).ChangeFont(MasterList, FontStack[StackIndex]);
               end;

             FontSy, BaseFontSy:
               begin
               Section.AddTokenObj(S, NoBreak);
               S.Clear;
               if ChangeTheFont(Sy, True) then
                 TSection(Section).ChangeFont(MasterList, FontStack[StackIndex]);
               end;
             FontEndSy:
               if StackIndex > InitialStackIndex then  
                 begin
                 PopFont;
                 Section.AddTokenObj(S, NoBreak);
                 S.Clear;
                 TSection(Section).ChangeFont(MasterList, FontStack[StackIndex]);
                 end;
             ASy:
               for I := 0 to Attributes.Count-1 do
                 with TAttribute(Attributes[I]) do
                   case Which of
                     NameSy:
                       if Name <> '' then
                         begin
                         Tmp := UpperCase(Name);
                         {Author may have added '#' by mistake}
                         if (Length(Tmp) > 0) and (Tmp[1] = '#') then
                           Delete(Tmp, 1, 1);
                         NameList.AddObject(Tmp, Section);
                         end;
                     HRefSy:
                       begin
                       Section.AddTokenObj(S, NoBreak);
                       S.Clear;
                       if InHref then DoAEnd;
                       if Name <> '' then  {also have a string}
                         begin
                         if Attributes.Find(TargetSy, T) then
                           CurrentUrlTarget.Assign(Name, T.Name)
                         else CurrentUrlTarget.Assign(Name, '');
                         InHref := True;
                         PushNewFont;
                         with FontStack[StackIndex] do
                           begin
                           Style := Style + MasterList.UnLine;
                           Color := MasterList.HotSpotColor;
                           end;
                         end;
                       Section.HRef(HRefSy, MasterList, CurrentUrlTarget, FontStack[StackIndex]);
                       end;
                     end;
             AEndSy:
               begin
               Section.AddTokenObj(S, NoBreak);
               S.Clear;
               DoAEnd;
               end;
             ImageSy:
               begin
               Section.AddTokenObj(S, NoBreak);
               TSection(Section).AddImage(Attributes, SectionList, TagIndex, NoBreak);
               S.Clear;
               end;
             InputSy, SelectSy:
               begin
               Section.AddTokenObj(S, NoBreak);
               FormControl := TSection(Section).AddFormControl(Sy, MasterList,
                           Attributes, SectionList, TagIndex, NoBreak);
               if Sy = SelectSy then
                 GetOptions(FormControl as TListBoxFormControlObj);
               S.Clear;;
               end;
             TextAreaSy:
               Begin
               Section.AddTokenObj(S, NoBreak);
               TxtArea := TSection(Section).AddFormControl(TextAreaSy, MasterList,
                          Attributes, SectionList, TagIndex, NoBreak) as TTextAreaFormControlObj;
               DoTextArea(TxtArea);
               S.Clear;
               end;
             FormSy:
               CurrentForm := ThtmlForm.Create(MasterList, Attributes);
             FormEndSy:
               CurrentForm := Nil;
             MapSy: DoMap;
             ScriptSy: DoScript(MasterList.ScriptEvent);
             end;
           end;
        ^M : begin NewSection; GetCh; end;
        EofChar : Done := True;
        else
          begin   {all other chars}
          S.AddChar(LCh, SIndex);  
          if Length(S.S) > 200 then
            begin
            Section.AddTokenObj(S, NoBreak);
            S.Clear;
            end;
          GetCh;
          end;
        end;
    Section.AddTokenObj(S, NoBreak);
    SectionList.Add(Section);
    Section := Nil;
    PreFormat := False;
    while StackIndex >= InitialStackIndex do   
      PopFont;
    Next;
  finally
    S.Free;   
    end;
  end;

  function CreateFont(HeadNmb: integer; OldFont: TMyFont): TMyFont;
  var
    F : TMyFont;
    Siz: integer;
  begin
  F := TMyFont.Create;
  F.Assign(OldFont);
  case HeadNmb of
    0: Siz := 12;     {0 is no heading}
    1: Siz := 24;
    2: Siz := 18; 
    3: Siz := 14;  
    4: Siz := 12;
    5: Siz := 10;
    6: Siz := 8;
    else Siz := 12;
  end;
  if HeadNmb > 0 then
    F.Style := F.Style + [fsBold];
  F.SetNormalSize(MasterList, Siz);
  Result := F;
  end;

begin
writeln('ThlParser.DoCommonSy A ',SymbNames[Sy]);
case Sy of
  TextSy :
    begin
writeln('ThlParser.DoCommonSy B ',Assigned(Section),' ',LCToken.S);
    if not Assigned(Section) then
      Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
                 CurrentUrlTarget, Justify);
    Section.AddTokenObj(LCToken, NoBreak);
    Next;
    end;
  ImageSy:
    begin
    if not Assigned(Section) then
      Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
                 CurrentUrlTarget, Justify);
    TSection(Section).AddImage(Attributes, SectionList, TagIndex, NoBreak);
    Next;
    end;
  InputSy, SelectSy:
    begin
    if not Assigned(Section) then
      Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
                 CurrentUrlTarget, Justify);
    FormControl := TSection(Section).AddFormControl(Sy, MasterList, Attributes, SectionList, TagIndex, NoBreak);
    if Sy = SelectSy then
      GetOptions(FormControl as TListBoxFormControlObj);
    Next;
    end;
  TextAreaSy:
    Begin
    if not Assigned(Section) then
      Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
                 CurrentUrlTarget, Justify);
    TxtArea := TSection(Section).AddFormControl(TextAreaSy, MasterList,
               Attributes, SectionList, TagIndex, NoBreak) as TTextAreaFormControlObj; 
    DoTextArea(TxtArea);
    Next;
    end;
  TextAreaEndSy:   {a syntax error but shouldn't hang}
    Next;
  FormSy:
    begin
    CurrentForm := ThtmlForm.Create(MasterList, Attributes);
    Next;
    end;
  FormEndSy:
    begin
    CurrentForm := Nil;
    Next;
    end;
  PSy, PEndSy:
    begin
    SectionList.Add(Section);
    Section := Nil;
    if Not NoPSpace then
      SectionList.Add(TParagraphSpace.Create(MasterList));
    SkipWhiteSpace;
    LastAlign := FindAlignment;
    NoPSpace := True;
    Next;
    while Sy in [PSy, PEndSy] do
      begin           {recognize only the first }
      LastAlign := FindAlignment;   {if a series of 
, get last alignment}
      SkipWhiteSpace;
      NoPSpace := True;
      Next;
      end;
    Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
               CurrentUrlTarget, LastAlign);
    end;
  BRSy:
    begin
    if Assigned(Section) then
      TmpJustify := TSection(Section).BreakInfo(TagIndex, NoBreak)  {so 
 doesn't change justification}
    else TmpJustify := Justify;
    SectionList.Add(Section);
    Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
               CurrentUrlTarget, TmpJustify);
    Section.DoClearAttribute(Attributes);     {check for clear attribute}
    Next;
    end;
  NoBrSy, NoBrEndSy:
    begin
    NoBreak := Sy = NoBrSy;
    if Assigned(Section) then
      Section.AddTokenObj(LCToken, NoBreak);
    Next;
    end;
  WbrSy:
    begin
    if Assigned(Section) and NoBreak then
      Section.AddChar(' ', TagIndex, NoBreak);
    Next;
    end;
  BSy, ISy, BEndSy, IEndSy, EmSy, EmEndSy, StrongSy, StrongEndSy,
      USy, UEndSy, CiteSy, CiteEndSy, VarSy, VarEndSy,
      SubSy, SubEndSy, SupSy, SupEndSy, SSy, SEndSy, StrikeSy, StrikeEndSy:
    begin
    case Sy of
      BSy, StrongSy:  CurrentStyle := CurrentStyle + [fsBold];
      BEndSy, StrongEndSy:  CurrentStyle := CurrentStyle - [fsBold];
      ISy, EmSy, CiteSy, VarSy:  CurrentStyle := CurrentStyle + [fsItalic];
      IEndSy, EmEndSy,
        CiteEndSy, VarEndSy:  CurrentStyle := CurrentStyle - [fsItalic];
      USy:  CurrentStyle := CurrentStyle + [fsUnderline];
      UEndSy:  CurrentStyle := CurrentStyle - [fsUnderline];
      SSy, StrikeSy:  CurrentStyle := CurrentStyle + [fsStrikeOut];
      SEndSy, StrikeEndSy:  CurrentStyle := CurrentStyle - [fsStrikeOut];
      SubEndSy, SupEndSy: CurrentSScript := Normal;
      SubSy, SupSy:
        begin
        if not Assigned(Section) then
          Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
                     CurrentUrlTarget, Justify);
        if Sy = SubSy then CurrentSScript := SubSc
          else CurrentSScript := SupSc;
        end;
      end;

    if Assigned(Section) then    {CurrentStyle used in ChangeFont}
      TSection(Section).ChangeFont(MasterList, FontStack[StackIndex]);
    Next;
    end;
  TTSy, CodeSy, KbdSy, SampSy:
    begin
    if PushNewFont then
      begin
      with FontStack[StackIndex] do
        begin
        Name := MasterList.PreFontName;
        SetNormalSize(MasterList, 10);
        Fixed := True;
        end;
      if Assigned(Section) then
        TSection(Section).ChangeFont(MasterList, FontStack[StackIndex]);
      end;
    Next;
    end;
  TTEndSy, CodeEndSy, KbdEndSy, SampEndSy, FontEndSy, BigEndSy, SmallEndSy:
    begin
    PopFont;
      if Assigned(Section) then
        TSection(Section).ChangeFont(MasterList, FontStack[StackIndex]);
    Next;
    end;
  FontSy, BaseFontSy:
    begin
    if ChangeTheFont(Sy, False) and Assigned(Section) then
      TSection(Section).ChangeFont(MasterList, FontStack[StackIndex]);
    Next;
    end;
  BigSy, SmallSy:
    begin
    if IncrementFont(Sy, False) and Assigned(Section) then
      TSection(Section).ChangeFont(MasterList, FontStack[StackIndex]);
    Next;
    end;
  AddressSy:
    begin
    SectionList.Add(Section);
    PushNewFont;
    with FontStack[StackIndex] do
      Style := Style + [fsItalic];
    Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
               CurrentUrlTarget, Justify);
    Next;
    end;
  AddressEndSy:
    begin
    SectionList.Add(Section);
    Section := Nil;
    PopFont;
    Next;
    end;
  ASy:
    begin
    for I := 0 to Attributes.Count-1 do
      with TAttribute(Attributes[I]) do
        case Which of
          NameSy:
            if Name <> '' then
              begin
              if not Assigned(Section) then
                Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
                           CurrentUrlTarget, Justify);
              Tmp := UpperCase(Name);
              {Author may have added '#' by mistake}
              if (Length(Tmp) > 0) and (Tmp[1] = '#') then
                Delete(Tmp, 1, 1);
              NameList.AddObject(Tmp, Section);
              end;
          HRefSy:
            begin
            if InHref then DoAEnd;
            if Name <> '' then  {also have a string}
              begin
              if Attributes.Find(TargetSy, T) then
                CurrentUrlTarget.Assign(Name, T.Name)
              else CurrentUrlTarget.Assign(Name, '');
              InHref := True;
              PushNewFont;
              with FontStack[StackIndex] do
                begin
                Style := Style + MasterList.UnLine;
                Color := MasterList.HotSpotColor;
                end;
              if Assigned(Section) then
                Section.HRef(HRefSy, MasterList, CurrentUrlTarget, FontStack[StackIndex]);
              end;
            end;
          end;
    Next;
    end;
  AEndSy:
    begin
    DoAEnd;
    Next;
    end;
  HeadingSy:
    begin
    if StackIndex < MaxStack then
      begin
      SectionList.Add(Section);
      Inc(StackIndex);
      FontStack[StackIndex] := CreateFont(Value, FontStack[StackIndex-1]);
      SectionList.Add(THeadingSpace.Create(MasterList, Value));
      Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
                 CurrentUrlTarget, FindAlignment);
      end;
    Next;
    end;
  HeadingEndSy:
    begin
    if StackIndex > 1 then
      begin
      SectionList.Add(Section);
      SectionList.Add(THeadingSpace.Create(MasterList, Value));
      Section := Nil;
      PopFont;
      end;
    Next;
    end;
  PreSy:  DoPreSy;
  TableSy: DoTable(Lev);
  MapSy: DoMap;
  ScriptSy: begin DoScript(MasterList.ScriptEvent); Next; end;
  end;
end;   {DoCommon}

{-------------DoLists}
procedure ThlParser.DoLists(Level: integer; Sym: Symb; const TermSet: SymbSet);
var
  LineCount, CurrentLevel: integer;
  T: TAttribute;
  Plain: boolean;
  Index: char;   

begin
LineCount := 1;
Index := '1';
Plain := False;
if (Sym = OLSy) then
  begin
  if Attributes.Find(StartSy, T) then
    if T.Value >= 0 then LineCount := T.Value;
  if Attributes.Find(TypeSy, T) and (T.Name <> '') then
    Index := T.Name[1];
  end
else Plain := (Sym = ULSy) and Attributes.Find(PlainSy, T);
CurrentLevel := Level;
SectionList.Add(Section);
Section := Nil;
Next;
if Sy in [OLEndSy, ULEndSy, DirEndSy, MenuEndSy, DLEndSy, BlockQuoteEndSy] then
  Exit;    {guard against 
 and similar combinations}
repeat
  case Sy of
    LISy:
      begin
      SectionList.Add(Section);
      if Sym = OLSy then
        begin
        Section := TOListItem.Create(MasterList, Level, LineCount, Index,
                    FontStack[StackIndex], CurrentUrlTarget);
        Inc(LineCount);
        end
      else Section := TUlistItem.Create(MasterList, Level, FontStack[StackIndex],
                      CurrentUrlTarget);
      if (Sym = ULSy) and Plain then
        TUlistItem(Section).Plain := True;
      CurrentLevel := Level;
      SkipWhiteSpace;
      Next;
      if Sy = PSy then Next;
      end;
    DTSy, DDSy:
      begin
      SectionList.Add(Section);
      if Sy = DTSy then
        CurrentLevel := Level-1
      else CurrentLevel := Level;
      Section := TDListItem.Create(MasterList, CurrentLevel, FontStack[StackIndex],
                 CurrentUrlTarget);
      Next;
      end;
    OLSy, ULSy, DirSy, MenuSy, DLSy:
      begin
      DoLists(Level+1, Sy, TermSet);
      Next;
      end;
    BlockQuoteSy:
      begin
      SectionList.Add(Section);
      Section := Nil;
      DoLists(Level+1, Sy, TermSet);
      Next;
      end;
    DivSy, CenterSy:
      DoBody(CurrentLevel, [OLEndSy, ULEndSy, DirEndSy, MenuEndSy, DLEndSy,
             BlockQuoteEndSy, EofSy]+TermSet);
    HRSy:
      begin
      SectionList.Add(Section);
      SectionList.Add(THorzLine.Create(MasterList, Attributes));
      Section := Nil;
      Next;
      end;
  TableSy:
      begin
      if Assigned(Section) then
        TSection(Section).BreakInfo(TagIndex, NoBreak);
      DoTable(CurrentLevel);   
      end;

    TextSy, BRSy, PSy, PEndSy,
    BSy, ISy, BEndSy, IEndSy, EmSy, EmEndSy, StrongSy, StrongEndSy,
        USy, UEndSy, CiteSy, CiteEndSy, VarSy, VarEndSy,
        SubSy, SubEndSy, SupSy, SupEndSy, SSy, SEndSy, StrikeSy, StrikeEndSy, 
    TTSy, CodeSy, KbdSy, SampSy,  TTEndSy, CodeEndSy, KbdEndSy, SampEndSy,
    NameSy, HRefSy, ASy, AEndSy,
    HeadingSy, HeadingEndSy, AddressSy, AddressEndSy, PreSy,
    InputSy, FormSy, FormEndSy, TextAreaSy, TextAreaEndSy, SelectSy,
    ImageSy, FontSy, FontEndSy, BaseFontSy, BigSy, BigEndSy, SmallSy,
    SmallEndSy, MapSy, ScriptSy, NoBrSy, NoBrEndSy, WbrSy:
      DoCommonSy(CurrentLevel);
    else if Sy in TermSet then Exit
      else Next;
    end;
Until (Sy in [OLEndSy, ULEndSy, DirEndSy, MenuEndSy, DLEndSy,
             BlockQuoteEndSy, EofSy]);
SectionList.Add(Section);
Section := Nil;
end;

{----------------DoBase}
procedure ThlParser.DoBase;
var
  I: integer;
begin
with Attributes do
  for I := 0 to Count-1 do
    with TAttribute(Attributes[I]) do
      if Which = HrefSy then
        Base := Name
      else if Which = TargetSy then
        BaseTarget := Name;
Next;
end;

procedure ThlParser.DoSoundEvent;
begin
SoundEvent(CallingObject, ATName, ALoop, False);
end;

{----------------DoSound}
procedure ThlParser.DoSound;
var
  T, T1: TAttribute;
begin
if Assigned(SoundEvent) and Attributes.Find(SrcSy, T) then
  begin
  if Attributes.Find(LoopSy, T1) then ALoop := T1.Value
    else ALoop := 1;
  ATName := T.Name;
  TParseThread(ParseThread).Synchronize(
    {$IFDEF HL_LAZARUS}@{$ENDIF}DoSoundEvent);
  end;
Next;
end;

function ThlParser.TranslateCharset(DefCharset: TFontCharset;
  const {$IFDEF HL_LAZARUS}NewContent{$ELSE}Content{$ENDIF}: string): TFontCharset;
type
  XRec = record S: string; CSet: TFontCharset; end;
const
  MaxX = 14;
  XTable: array[1..MaxX] of XRec =
     ((S:'1252';    CSet:ANSI_CHARSET),
      (S:'8859-1';    CSet:ANSI_CHARSET),
      (S:'1253';    CSet:GREEK_CHARSET),
      (S:'8859-7';    CSet:GREEK_CHARSET),
      (S:'1250';    CSet:EASTEUROPE_CHARSET),
      (S:'8859-2';    CSet:EASTEUROPE_CHARSET),
      (S:'1251';    CSet:RUSSIAN_CHARSET),
      (S:'8859-5';    CSet:RUSSIAN_CHARSET),
      (S:'koi8-r';    CSet:RUSSIAN_CHARSET),
      (S:'1254';    CSet:TURKISH_CHARSET),
      (S:'8859-3';    CSet:TURKISH_CHARSET),
      (S:'8859-9';    CSet:TURKISH_CHARSET),
      (S:'1257';    CSet:BALTIC_CHARSET),
      (S:'8859-4';    CSet:BALTIC_CHARSET));
var
  I: integer;
begin
Result := DefCharset;
for I := 1 to MaxX do
  if Pos(XTable[I].S,
    Lowercase({$IFDEF HL_LAZARUS}NewContent{$ELSE}Content{$ENDIF})) > 0
  then
    Begin
    Result := XTable[I].CSet;
    Break;
    end;
end;

procedure ThlParser.DoMetaEvent;
begin
MetaEvent(CallingObject, HttpEq, ATName, Content);
end;

{----------------DoMeta}
procedure ThlParser.DoMeta(Sender: TObject);
var
  T: TAttribute;
  {$ifdef ver100_plus}
  Charset: TFontCharset;
  {$endif}
begin
if Attributes.Find(HttpEqSy, T) then HttpEq := T.Name
  else HttpEq := '';
if Attributes.Find(NameSy, T) then ATName := T.Name
  else ATName := '';
if Attributes.Find(ContentSy, T) then Content := T.Name
  else Content := '';
{$ifdef ver100_plus}
if (Sender is ThtmlLite) and (CompareText(HttpEq, 'content-type') = 0) then  
  begin
  CharSet := TranslateCharset(TSectionList(SectionList).Charset, Content);
  FontStack[StackIndex].Charset := Charset;
  end;
{$endif}
if Assigned(MetaEvent) then
  TParseThread(ParseThread).Synchronize({$IFDEF HL_LAZARUS}@{$ENDIF}DoMetaEvent);
Next;
end;

{----------------DoTitle}
procedure ThlParser.DoTitle;
begin
Title := '';
Next;
while Sy = TextSy do
  begin
  Title := Title+LCToken.S;
  Next;
  end;
end;

{-------------DoBody}
procedure ThlParser.DoBody(Level: integer; const TermSet: SymbSet);
var
  I, SaveIndent: integer;  
  Val: TColor;
  T: TAttribute;
  SaveJustify: JustifyType;
  S: string[10];
  SaveSy: Symb;

begin
repeat
writeln('ThlParser.DoBody ',SymbNames[Sy]);
  case Sy of
    TextSy, BRSy, PSy, PEndSy,
    NameSy, HRefSy, ASy, AEndSy,
    BSy, ISy, BEndSy, IEndSy, EmSy, EmEndSy, StrongSy, StrongEndSy,
        USy, UEndSy, CiteSy, CiteEndSy, VarSy, VarEndSy,
        SubSy, SubEndSy, SupSy, SupEndSy,  SSy, SEndSy, StrikeSy, StrikeEndSy,
    TTSy, CodeSy, KbdSy, SampSy,  TTEndSy, CodeEndSy, KbdEndSy, SampEndSy,
    HeadingSy, HeadingEndSy, AddressSy, AddressEndSy, PreSy, TableSy,
    InputSy, FormSy, FormEndSy, TextAreaSy, TextAreaEndSy, SelectSy,
    ImageSy, FontSy, FontEndSy, BaseFontSy, BigSy, BigEndSy, SmallSy,
    SmallEndSy, MapSy, ScriptSy, NoBrSy, NoBrEndSy, WbrSy:
      DoCommonSy(Level);
    BodySy:
      begin
      if SectionList.Count = 0 then   {make sure we're at beginning}
        begin
writeln('ThlParser.DoBody B ',SymbNames[Sy],' ');
        Section.Free;   {Will start with a new section}
        for I := 0 to Attributes.Count-1 do
          with TAttribute(Attributes[I]) do
            case Which of
              BackgroundSy: MasterList.SetBackgroundBitmap(Name);
              TextSy: if GetColor(Name, Val) then
                begin
                FontStack[StackIndex].Color := Val or $2000000;
                MasterList.FontColor := Val or $2000000;
                end;
              BGColorSy: if GetColor(Name, Val) then MasterList.SetBackGround(Val or $2000000);
              LinkSy: if GetColor(Name, Val) then MasterList.HotSpotColor := Val or $2000000;
              VLinkSy: if GetColor(Name, Val) then MasterList.LinkVisitedColor := Val or $2000000;
              OLinkSy: if GetColor(Name, Val) then
                 begin
                 MasterList.LinkActiveColor := Val or $2000000;
                 MasterList.LinksActive := True;
                 end;
              MarginWidthSy:   
                if CallingObject is ThtmlLite then
                  ThtmlLite(CallingObject).FMarginWidthX := IntMin(IntMax(0,Value), 200);
              MarginHeightSy:
                if CallingObject is ThtmlLite then
                  ThtmlLite(CallingObject).FMarginHeightX := IntMin(IntMax(0,Value), 200);
            end;
        Section := TSection.Create(MasterList, Level, FontStack[1], Nil, Justify);
        end;
      Next;
      end;
    HRSy:
      begin
      SectionList.Add(Section);
      SectionList.Add(THorzLine.Create(MasterList, Attributes));
      Section := Nil;
      Next;
      end;
    OLSy, ULSy, DirSy, MenuSy, DLSy:
      begin
      DoLists(1, Sy, TermSet);
      Next;
      end;
    LiSy:
      if Level = 0 then
        begin
        SectionList.Add(Section);
        SaveIndent := ListIndent;
        ListIndent := SmallListIndent;
        Section := TUlistItem.Create(MasterList, 1, FontStack[StackIndex],
                      CurrentUrlTarget);
        SkipWhiteSpace;
        Next;
        while Sy in [TextSy, NoBrSy, NoBrEndSy, WbrSy, BSy, ISy, BEndSy, IEndSy,
                     EmSy, EmEndSy, StrongSy, StrongEndSy, USy, UEndSy, CiteSy,
                     CiteEndSy, VarSy, VarEndSy, SubSy, SubEndSy, SupSy, SupEndSy,
                     SSy, SEndSy, StrikeSy, StrikeEndSy, TTSy, CodeSy, KbdSy, SampSy,
                     TTEndSy, CodeEndSy, KbdEndSy, SampEndSy, FontEndSy, BigEndSy,
                     SmallEndSy, BigSy, SmallSy, ASy, AEndSy] do
          begin
          DoCommonSy(1);
          end;
        SectionList.Add(Section);
        Section := Nil;
        ListIndent := SaveIndent;
        end
      else Next;
    BlockQuoteSy:
      begin
      SectionList.Add(Section);
      Section := Nil;
      DoLists(1, Sy, TermSet);
      Next;
      end;
    DivSy, CenterSy:
      begin
      SaveSy := Sy;
      SectionList.Add(Section);
      SaveJustify := Justify;
      if SaveSy = CenterSy then
        Justify := Centered
      else
        if Attributes.Find(AlignSy, T) then
          begin
          S := LowerCase(T.Name);
          if S = 'left' then Justify := Left
          else if S = 'center' then Justify := Centered
          else if S = 'right' then Justify := Right;
          end;
      Section := TSection.Create(MasterList, Level, FontStack[StackIndex],
                 CurrentUrlTarget, Justify);
      Next;
      DoBody(Level, [CenterEndSy, DivEndSy]+TermSet);
      SectionList.Add(Section);
      Justify := SaveJustify;
      Section := TSection.Create(MasterList, Level, FontStack[StackIndex],
                 CurrentUrlTarget, Justify);
      if Sy in [CenterEndSy, DivEndSy] then
        Next;
      end;
    TitleSy:
      DoTitle;
    BgSoundSy:
      DoSound;
    MetaSy:
      DoMeta(CallingObject);
    BaseSy:
      DoBase;
    else if Sy in TermSet then Exit
    else Next;
    end;
Until (Sy = EofSy);
Next;
end;

procedure ThlParser.ParseInit(ASectionList: TList; ANameList: TStringList; AIncludeEvent: TIncludeType);
begin
SectionList := TSectionList(ASectionList);
MasterList := TSectionList(SectionList);
CallingObject := TSectionList(ASectionList).TheOwner;
IncludeEvent := AIncludeEvent;
NameList := ANameList;
PreFormat := False;
StackIndex := 1;
FontStack[1] := TMyFont.Create;
FontStack[1].Name := MasterList.FontName;
FontStack[1].Color := MasterList.FontColor;
FontStack[1].SetNormalSize(MasterList, 12);
{$ifdef ver100_plus}
FontStack[1].Charset := TSectionList(SectionList).Charset;
{$endif}
CurrentURLTarget := TUrlTarget.Create;
InHref := False;
BaseFontSize := 3;

Title := '';
Base := '';
BaseTarget := '';
Justify := Left;
CurrentStyle := [];
CurrentForm := Nil;
Section := TSection.Create(MasterList, 0, FontStack[1], Nil, Justify);
Attributes := TAttributeList.Create;
SIndex := -1;
InScript := False;
NoPSpace := False;
NoBreak := False;
end;

{----------------ThlParser.HtmlParseString}
procedure ThlParser.HtmlParseString(ASectionList: TList; ANameList: TStringList;
                   AIncludeEvent: TIncludeType; ASoundEvent: TSoundType;
                   AMetaEvent: TMetaType);
begin
LoadStyle := lsPrimary;
ParseInit(ASectionList, ANameList, AIncludeEvent);
SoundEvent := ASoundEvent;
MetaEvent := AMetaEvent;
Buffer := TParseThread(ParseThread).Buffer;
BuffEnd := TParseThread(ParseThread).BuffEnd;
try
  try
    GetCh; {get the reading started}
    Next;
    DoBody(0, []);
  except
    On EParseError do;   {ignore this error}
  end;
finally
  Attributes.Free;
  if Assigned(Section) then
    SectionList.Add(Section);
  while StackIndex >= 1 do
    begin
    FontStack[StackIndex].Free;
    Dec(StackIndex);
    end;
  CurrentURLTarget.Free;
  end;
end;

{----------------DoText}
procedure ThlParser.DoText;        
var
  S: TokenObj;
  Done: boolean;

  procedure NewSection;
  begin
  Section.AddTokenObj(S, NoBreak);
  S.Clear;
  SectionList.Add(Section);
  Section := TPreFormated.Create(MasterList, 0, FontStack[StackIndex], CurrentURLTarget, Left);
  end;

begin
S := TokenObj.Create;
try
  SectionList.Add(Section);
  PushNewFont;
  with FontStack[StackIndex] do
    begin
    Name := MasterList.PreFontName;
    SetNormalSize(MasterList, 10);
    Fixed := True;
    end;
  Section := TPreformated.Create(MasterList, 0, FontStack[StackIndex],
             CurrentURLTarget, Left);
  PreFormat := True;
  Done := False;
  while not Done do
    case Ch of
      ^M : begin NewSection; GetCh; end;
      EofChar : Done := True;
      else
        begin   {all other chars}
        S.AddChar(LCh, SIndex);
        if Length(S.S) > 200 then
          begin
          Section.AddTokenObj(S, NoBreak);
          S.Clear;
          end;
        GetCh;
        end;
      end;
  Section.AddTokenObj(S, NoBreak);
  SectionList.Add(Section);
  Section := Nil;
  PreFormat := False;
  PopFont;
finally
  S.Free;
  end;
end;

{-------------HtmlParseTextString}
procedure ThlParser.HtmlParseTextString(ASectionList: TList; ANameList: TStringList);
begin
LoadStyle := lsPrimary;
ParseInit(ASectionList, ANameList, Nil);
SoundEvent := Nil;
MetaEvent := NIl;
Buffer := TParseThread(ParseThread).Buffer;
BuffEnd := TParseThread(ParseThread).BuffEnd;

try
  try
    GetCh; {get the reading started}
    DoText;
  except
    On EParseError do;   {ignore this error}
  end;

finally
  Attributes.Free;
  if Assigned(Section) then
    SectionList.Add(Section);
  while StackIndex >= 1 do
    begin
    FontStack[StackIndex].Free;
    Dec(StackIndex);
    end;
 end;   {finally}
end;

constructor ThlParser.Create;
begin
inherited;
LCToken := TokenObj.Create;
end;

destructor ThlParser.Destroy;
begin
LCToken.Free;
inherited;
end;


end.