pas2js/tools/html2form/formgen.pas

{
    This file is part of the Pas2JS toolchain
    Copyright (c) 2020 by Michael Van Canneyt

    This unit implements a HTML to pascal class converter.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
unit formgen;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, sax, sax_html, pascodegen, fpjson, jsonparser;

Type
  TLogEvent = Procedure (Sender : TObject; Const Msg : String) of object;

  { TFormElement }

  TFormElement = Class(TCollectionItem)
  private
    FHTMLID: String;
    FName: String;
    FType: String;
    FEvents : TStrings;
    function GetEvents: TStrings;
    function getName: String;
    procedure SetEvents(AValue: TStrings);
  Public
    Destructor Destroy; override;
    Function HasEvents : Boolean;
    Procedure Assign(Source : TPersistent); override;
  Published
    Property Name : String Read getName Write FName;
    Property HTMLID : String Read FHTMLID Write FHTMLID;
    Property ElementType : String Read FType Write FType;
    Property Events : TStrings Read GetEvents Write SetEvents;
  end;

  { TFormElementList }

  TFormElementList = CLass(TCollection)
  private
    function GetEl(aIndex : Integer): TFormElement;
  Public
    Function Add(Const aName : string) : TFormElement;
    Function IndexOf(Const aName : string) : Integer;
    Function Find(Const aName : string) : TFormElement;
    Property Elements[aIndex : Integer] : TFormElement Read GetEl; default;
  end;
  
  TAttributeOperation = (aoNotPresent,aoPresent,aoEqual,aoNotEqual,aoContains);   

  { TAttributeCondition }

  TAttributeCondition = Class(TCollectionItem)
  private
    FAttribute: String;
    FOperation: TAttributeOperation;
    FValue: String;
  Public
    Procedure LoadFromJSON(aName : String; aValue: TJSONData);
    function IsMatch(aValue: String): Boolean;
    Property Attribute : String Read FAttribute Write FAttribute;
    Property Operation : TAttributeOperation Read FOperation Write FOperation;
    Property Value : String Read FValue Write FValue;
  end;
  
  { TAttributeConditionList }

  TAttributeConditionList = Class(TCollection)
  private
    function GetC(aIndex : Integer): TAttributeCondition;
  Public
    Procedure LoadFromJSON(aJSON : TJSONObject);
    Function IsMatch(Attrs: TSAXAttributes): Boolean;
    Property Conditions[aIndex : Integer] : TAttributeCondition Read GetC; default;
  end;
  
(* // Structure of accepted JSON
  [
   {
     "class" : "TWebComboBox",
     "tag" : "input",
     "attrs" : {
        name0 : null, // name0 Not present
        name1 : "value",  // name1 equals value
        name2 ; "-value", // name2 does not equal value 
        name3 : "~value"  // name3 contains value
       }
   }
  ]
*)

  { THTMLElementMap }

  THTMLElementMap = Class(TCollectionItem)
  private
    FConditionList : TAttributeConditionList;
    FControlClass: String;
    FTag: String;
    function GetAttrConditionList: TAttributeConditionList;
  Protected
    Function CreateConditionList : TAttributeConditionList; virtual;
  Public
    Destructor Destroy; override;
    Procedure LoadFromJSON(aJSON : TJSONObject);
    Function HasConditions : Boolean;
    Function IsMatch(aTag: SAXString; Attrs: TSAXAttributes): Boolean;
    Property Tag : String Read FTag Write FTag;
    Property ControlClass : String Read FControlClass Write FControlClass;
    Property Attributes : TAttributeConditionList Read GetAttrConditionList;
  end;

  { THTMLElementMapList }

  THTMLElementMapList = Class(TCollection)
  private
    function GetM(aIndex : Integer): THTMLElementMap;
  Public
    Procedure LoadFromFile(Const aFileName : String);
    Procedure LoadFromStream(aStream : TStream); virtual;
    Procedure LoadFromJSON(aJSON : TJSONArray); virtual;
    Function IndexOfMap(aTag: SAXString; Attrs: TSAXAttributes): Integer;
    Function FindMap(aTag: SAXString; Attrs: TSAXAttributes): THTMLElementMap;
    Property Maps[aIndex : Integer] : THTMLElementMap Read GetM; default;
  end;
  

  { THTMLToFormELements }

  THTMLToFormELements = class(TComponent)
  private
    FBelowID: String;
    FDefaultElements: Boolean;
    FExcludeIDS: TStrings;
    FFormElements: TFormElementList;
    FLevel : Integer;
    FMap: THTMLElementMapList;
    FOnLog: TLogEvent;
    function MakeValidName(aID: string): string;
    procedure SetExcludeIDS(AValue: TStrings);
    procedure SetFormElements(AValue: TFormElementList);
  protected
    Procedure DoLog(Const Msg : String);
    Procedure DoLog(Const Fmt : String; Args : Array of const);
    function CreateHTMLElementMapList: THTMLElementMapList; virtual;
    procedure GetEvents(aEl: TFormElement; Atts: TSAXAttributes); virtual;
    procedure DoEndElement(Sender: TObject; const {%H-}NamespaceURI, {%H-}LocalName,
      {%H-}QName: SAXString);  virtual;
    procedure DoStartElement(Sender: TObject; const {%H-}NamespaceURI, LocalName,
      {%H-}QName: SAXString; Atts: TSAXAttributes);  virtual;
    function Maptype(aTag: SAXString; Atts: TSAXAttributes): String; virtual;
    Class Function CreateElementList : TFormElementList;  virtual;
    Property Level : Integer Read FLevel Write FLevel;
  Public
    Constructor Create(aOwner : TComponent); override;
    Destructor Destroy; override;
    Procedure Clear;
    Procedure LoadFromStream(aInput : TStream);
    Procedure LoadFromFile(Const aFileName : String);
    Property FormElements : TFormElementList Read FFormElements Write SetFormElements;
    Property BelowID : String Read FBelowID Write FBelowID;
    Property ExcludeIDS : TStrings Read FExcludeIDS Write SetExcludeIDS;
    Property Map : THTMLElementMapList Read FMap;
    Property DefaultElements : Boolean Read FDefaultElements Write FDefaultElements;
    Property OnLog : TLogEvent Read FOnLog Write FOnLog;
  end;

  { TFormCodeGen }

  TSpecialMethod = (smConstructor,smBindElements,smBindElementEvents);
  TSpecialMethods = Set of TSpecialMethod;
  TFormOption = (foEvents,foFormFile,foBindInConstructor);
  TFormOptions = Set of TFormOption;

  { TFormFileCodeGen }

  TFormFileCodeGen = Class(TPascalCodeGenerator)
  private
    FElementHeight: Word;
    FElementHSpacing: Word;
    FElementVSpacing: Word;
    FElementWidth: Word;
    FDoEvents: Boolean;
    FFormClassName: String;
    FFormElements: TFormElementList;
    FIDProperty: String;
    FLeft: Word;
    FMaxHeight: Word;
    FMaxWidth: Word;
    FTop: Word;
  Protected
    function GetFormName(const aClassName: string): String; virtual;
    procedure GenerateElements; virtual;
    procedure EmitElementEvents(El: TFormElement); virtual;
    procedure EmitElementProps(El: TFormElement); virtual;
    procedure NextPosition; virtual;
    Property ELeft : Word Read FLeft Write FLeft;
    Property ETop : Word Read FTop Write FTop;
  Public
    Constructor Create(aOwner : TComponent);override;
    Procedure Execute;
    Property FormElements: TFormElementList read FFormElements write FFormElements;
    Property FormClassName : String read FFormClassName write FFormClassName;
    Property DoEvents : Boolean read FDoEvents write FDoEvents;
    Property IDProperty : String Read FIDProperty Write FIDProperty;
    Property ElementHeight : Word Read FElementHeight Write FElementHeight;
    Property ElementWidth : Word Read FElementWidth Write FElementWidth;
    Property MaxWidth : Word Read FMaxWidth Write FMaxWidth;
    Property MaxHeight : Word Read FMaxHeight Write FMaxHeight;
    Property ElementHSpacing : Word Read FElementHSpacing Write FElementHSpacing;
    Property ElementVSpacing : Word Read FElementVSpacing Write FElementVSpacing;
  end;

  TFormCodeGen = Class(TPascalCodeGenerator)
  private
    FAddMethods: TSpecialMethods;
    FConstructorArgs: String;
    FEventModifiers: String;
    FEventSignature: string;
    FFormClassName: string;
    FFormElements: TFormElementList;
    fFormFileGenerator: TFormFileCodeGen;
    FFormSource: Tstrings;
    FGetElementFunction: string;
    FOptions: TFormOptions;
    FOverrideMethods: TSpecialMethods;
    FParentClassName: string;
    FVirtualMethods: TSpecialMethods;
    procedure SetFormElements(AValue: TFormElementList);
  Protected
    function BaseUnits : String; override;
    Function CreateHTMLToFormELements: THTMLToFormELements;  virtual;
    Class Function CreateElementList : TFormElementList;  virtual;
    procedure EmitFormFile; virtual;
    function CreateFormFileGen : TFormFileCodeGen; virtual;
    procedure EmitFormElement(aEL: TFormElement); virtual;
    procedure EmitFormEvents(aEL: TFormElement);virtual;
    procedure EmitImplementation; virtual;
    procedure EmitPublicSection; virtual;
    procedure EmitPublishedSection; virtual;
    procedure EmitFormBindElements; virtual;
    procedure EmitFormBindEvents; virtual;
    procedure EmitFormConstructor; virtual;
    function VirtualOverride(M: TSpecialMethod; const Decl: String): string; virtual;
   Public
    Constructor Create(aOwner : TComponent); override;
    Destructor Destroy; override;
    class function Pretty(const S: String): string; virtual;
    class procedure GetEventNameAndHandler(const S,aFieldName: String; out aName, aHandler: string);
    Procedure Execute;
    Property FormFileGenerator  : TFormFileCodeGen Read fFormFileGenerator Write FFormFileGenerator;
    Property FormElements : TFormElementList Read FFormElements Write SetFormElements;
    Property FormClassName : string Read FFormClassName Write FFormClassName;
    Property ParentClassName : string Read FParentClassName Write FParentClassName;
    Property GetElementFunction : string Read FGetElementFunction Write FGetElementFunction;
    Property EventSignature: string Read FEventSignature Write FEventSignature;
    Property EventModifiers : String Read FEventModifiers Write FEventModifiers;
    Property ConstructorArgs : String Read FConstructorArgs Write FConstructorArgs;
    Property Options : TFormOptions Read FOptions Write FOptions;
    Property AddMethods : TSpecialMethods Read  FAddMethods Write FAddMethods;
    Property OverrideMethods : TSpecialMethods Read  FOverrideMethods Write FOverrideMethods;
    Property VirtualMethods : TSpecialMethods Read  FVirtualMethods Write FVirtualMethods;
    Property FormSource : Tstrings Read FFormSource;
  end;

implementation

{ TFormFileCodeGen }

function TFormFileCodeGen.GetFormName(const aClassName: string): String;

begin
  Result:=aClassName;
  if SameText(Copy(Result,1,1),'T') then
    Delete(Result,1,1);
end;

(*
procedure TFormFileCodeGen.LoadFromStream(const AStream: TStream);
begin
  if aStream=Nil then exit;
end;
*)

constructor TFormFileCodeGen.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  IDProperty:='ElementID';
  ElementHeight:=24;
  ElementWidth:=72;
  ElementVSpacing:=8;
  ElementHSpacing:=16;
  MaxWidth:=800;
  MaxHeight:=600;
end;

procedure TFormFileCodeGen.NextPosition;
begin
  ELeft:=ELeft+ElementWidth+ElementHSpacing;
  if ELeft+ElementWidth>=MaxWidth then
    begin
    ELeft:=8;
    ETop:=ETop+ElementHeight+ElementVSpacing;
    end;
end;

procedure TFormFileCodeGen.EmitElementProps(El : TFormElement);

begin
  AddLn('Top = %d',[ETop]);
  AddLn('Left = %d',[ELeft]);
  Addln('Width = %d',[ElementWidth]);
  Addln('Height = %d',[ElementHeight]);
  addLn('%s = ''%s''',[IDProperty,El.Name]);
end;

procedure TFormFileCodeGen.EmitElementEvents(El : TFormElement);

Var
  S,EN,EH : String;

begin
  For S in El.Events do
    begin
    TFormCodeGen.GetEventNameAndHandler(S,El.Name,EN,EH);
    Addln('%s = %s',[EN,EH]);
    end;
end;

procedure TFormFileCodeGen.GenerateElements;

Var
  I : Integer;
  El : TFormElement;

begin
  For I:=0 to FormElements.Count-1 do
    begin
    el:=FormElements[i];
    With El do
      begin
      Addln('object %s: %s',[Name,ElementType]);
      Indent;
      EmitElementProps(EL);
      if DoEvents then
        EmitElementEvents(El);
      Undent;
      AddLn('end');
      NextPosition;
      end;
    end;
end;

procedure TFormFileCodeGen.Execute;


begin
  ETop:=8;
  ELeft:=8;
  AddLn('object %s : %s',[GetFormName(FormClassName),FormClassName]);
  Indent;
  AddLn('Width = %d',[MaxWidth]);
  AddLn('Height = %d',[MaxHeight]);
  GenerateElements;
  Undent;
  AddLn('end');
end;

{ THTMLElementMapList }

function THTMLElementMapList.GetM(aIndex : Integer): THTMLElementMap;
begin
  Result:=Items[aIndex] as THTMLElementMap;
end;

procedure THTMLElementMapList.LoadFromFile(const aFileName: String);

Var
  F : TFileStream;

begin
  F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(F);
  finally
    F.Free;
  end;
end;

procedure THTMLElementMapList.LoadFromStream(aStream: TStream);

Var
  D : TJSONData;

begin
  D:=GetJSON(aStream);
  try
    if D is TJSONArray then
      LoadFromJSON(D as TJSONArray);
  finally
    D.Free;
  end;
end;

procedure THTMLElementMapList.LoadFromJSON(aJSON: TJSONArray);

Var
  E : TJSONEnum;

begin
  For E in aJSON do
    if E.Value is TJSONObject then
      (Add as THTMLElementMap).LoadFromJSON(e.Value as TJSONObject);
end;

function THTMLElementMapList.IndexOfMap(aTag: SAXString; Attrs: TSAXAttributes
  ): Integer;
begin
  Result:=0;
  While (Result<Count) and Not GetM(Result).IsMatch(aTag,Attrs) do
    Inc(Result);
  if Result=Count then
    Result:=-1;
end;

function THTMLElementMapList.FindMap(aTag: SAXString; Attrs: TSAXAttributes
  ): THTMLElementMap;

Var
  Idx : Integer;

begin
  Idx:=IndexOfMap(aTag,Attrs);
  If Idx=-1 then
    Result:=Nil
  else
    Result:=GetM(Idx);
end;

{ THTMLElementMap }

function THTMLElementMap.GetAttrConditionList: TAttributeConditionList;
begin
  If FConditionList=Nil then
    FConditionList:=CreateConditionList;
  Result:=FConditionList
end;

function THTMLElementMap.CreateConditionList: TAttributeConditionList;
begin
  Result:=TAttributeConditionList.Create(TAttributeCondition);
end;

destructor THTMLElementMap.Destroy;
begin
  FreeAndNil(FConditionList);
  inherited Destroy;
end;

procedure THTMLElementMap.LoadFromJSON(aJSON: TJSONObject);

Var
  A : TJSONObject;

begin
  FTag:=aJSON.Get('tag','');
  ControlClass:=aJSON.Get('class','');
  A:=aJSON.Get('attrs',TJSONObject(Nil));
  If Assigned(A) then
    Attributes.LoadFromJSON(A);
end;

function THTMLElementMap.HasConditions: Boolean;
begin
  Result:=Assigned(FConditionList) and (FConditionList.Count>0);
end;

function THTMLElementMap.IsMatch(aTag: SAXString; Attrs: TSAXAttributes): Boolean;
begin
  Result:=SameText(UTF8Encode(aTag),FTag);
  if Result and HasConditions then
    Result:=Attributes.IsMatch(Attrs);
end;

{ TAttributeConditionList }

function TAttributeConditionList.GetC(aIndex : Integer): TAttributeCondition;
begin
  Result:=TAttributeCondition(Items[aIndex]);
end;

procedure TAttributeConditionList.LoadFromJSON(aJSON: TJSONObject);

Var
  E : TJSONEnum;
  A : TAttributeCondition;

begin
  For E in aJSON do
    begin
    A:=Add as TAttributeCondition;
    A.LoadFromJSON(E.Key,E.Value);
    end;
end;

function TAttributeConditionList.IsMatch(Attrs: TSAXAttributes): Boolean;

  function GetIndex(const aName: SAXString): Integer;

  begin
    Result := Attrs.Length-1;
    while (Result>=0) and not SameText(UTF8Encode(Attrs.LocalNames[Result]),UTF8Encode(aName)) do
      Dec(Result);
  end;

Var
  I,Idx : Integer;
  A : TAttributeCondition;
begin
  Result:=True;
  I:=0;
  While Result and (I<Count) do
    begin
    A:=GetC(I);
    Idx:=GetIndex(UTF8Decode(A.Attribute));
    if A.Operation=aoNotPresent then
      Result:=Idx<0
    else
      Result:=A.IsMatch(UTF8Encode(Attrs.GetValue(Idx)));
    Inc(I);
    end;
end;

{ TAttributeCondition }

procedure TAttributeCondition.LoadFromJSON(aName: String; aValue: TJSONData);

Var
  S : TJSONStringType;
  C : Char;

begin
  Attribute:=aName;
  if aValue.JSONType=jtNull then
    Operation:=aoNotPresent
  else if aValue.JSONType=jtBoolean then
    begin
    if aValue.AsBoolean then
      Operation:=aoPresent
    else
      Operation:=aoNotPresent
    end
  else
    begin
    S:=aValue.AsString;
    If S<>'' then
      C:=S[1]
    else
      C:=#0;

    Case C of
      '-' : Operation:=aoNotEqual;
      '~' : Operation:=aoContains;
    else
      Operation:=aoEqual;
      Value:=S;
    end;
    if Operation in [aoNotEqual,aoContains] then
      Value:=Copy(S,2,Length(S)-1);
    end;
end;

function TAttributeCondition.IsMatch(aValue: String): Boolean;
begin
  Case Operation of
    aoPresent : Result:=True;
    aoNotEqual : Result:=Not SameText(aValue,Value);
    aoEqual : Result:=SameText(aValue,Value);
    aoContains : Result:=Pos(LowerCase(Value),LowerCase(aValue))>0;
  end;
end;


{ THTMLToFormELements }

procedure THTMLToFormELements.SetFormElements(AValue: TFormElementList);
begin
  if FFormElements=AValue then Exit;
  FFormElements:=AValue;
end;

procedure THTMLToFormELements.DoLog(const Msg: String);
begin
  if Assigned(FOnLog) then
    FOnLog(Self,Msg);
end;

procedure THTMLToFormELements.DoLog(const Fmt: String; Args: array of const);
begin
  DoLog(Format(Fmt,Args));
end;

function THTMLToFormELements.Maptype(aTag: SAXString; Atts: TSAXAttributes): String;

var
  t : string;
  m : THTMLElementMap;

begin
  Result:='';
  if Map.Count>0 then
    begin
    M:=Map.FindMap(aTag,Atts);
    if Assigned(m) then
      Exit(M.ControlClass)
    else if not DefaultElements then
      begin
      DoLog('Could not map tag %s',[aTag]);
      Exit;
      end;
    end;
  t:=lowercase(Utf8Encode(aTag));
  case t of
    'input' : Result:='TJSHTMLInputElement';
    'button' : Result:='TJSHTMLButtonElement';
    'select' : Result:='TJSHTMLSelectElement';
    'textarea' : Result:='TJSHTMLTextAreaElement';
    'option' : Result:='';
  else
    Result:='TJSHTMLElement';
  end;
end;

function THTMLToFormELements.MakeValidName(aID: string): string;

Var
  C : Char;

begin
  Result:='';
  for C in aID do
    if C in ['_','a'..'z','A'..'Z','0'..'9'] then
      Result:=Result+C
    else
      Result:=Result+'_';
end;

procedure THTMLToFormELements.SetExcludeIDS(AValue: TStrings);
begin
  if FExcludeIDS=AValue then Exit;
  FExcludeIDs.AddStrings(AValue,True);
end;

procedure THTMLToFormELements.DoStartElement(Sender: TObject;
  const NamespaceURI, LocalName, QName: SAXString; Atts: TSAXAttributes);

Var
  aID,aType : String;
  El : TFormElement;
begin
  if Not Assigned(atts) then exit;
  aID:=UTF8Encode(Atts.GetValue('','id'));
  if (aID='') or (FExcludeIDS.IndexOf(aID)>=0) then
    exit;
  if (Level=0) and (BelowID=aID) then
    Level:=1
  else if (BelowID<>'') and (Level<=0) then
    Exit;
  aType:=MapType(LocalName,Atts);
  if aType='' then
    DoLog('Ignoring tag %s with id %s',[LocalName,aID])
  else
    begin
    El:=FormElements.Add(MakeValidName(aID));
    EL.ElementType:=aType;
    EL.HTMLID:=aId;
    GetEvents(El,Atts);
    end
end;

procedure THTMLToFormELements.GetEvents(aEl : TFormElement; Atts : TSAXAttributes);

Var
  I,aLen : Integer;
  aName : string;

begin
  for I:=0 to Atts.Length-1 do
    begin
    aName:=UTF8Encode(Atts.GetLocalName(i));
    aLen:=Length(aName);
    if (aLen>3) and (Copy(aName,1,1)='_') and (Copy(aName,aLen,1)='_') then
      aEl.Events.Add(Copy(aName,2,aLen-2)+'='+UTF8Encode(Atts.GetValue(i)));
    end;
end;

procedure THTMLToFormELements.DoEndElement(Sender: TObject; const NamespaceURI,
  LocalName, QName: SAXString);
begin
  if Level>0 then
  Dec(FLevel);
end;

class function THTMLToFormELements.CreateElementList: TFormElementList;
begin
  Result:=TFormElementList.Create(TFormElement);
end;

function THTMLToFormELements.CreateHTMLElementMapList: THTMLElementMapList;

begin
  Result:=THTMLElementMapList.Create(THTMLElementMap);
end;

constructor THTMLToFormELements.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FMap:=CreateHTMLElementMapList;
  FFormElements:=CreateElementList;
  FExcludeIDS:=TStringList.Create;
  TStringList(FExcludeIDS).Sorted:=True;
end;

destructor THTMLToFormELements.Destroy;
begin
  FreeAndNil(FMap);
  FreeAndNil(FExcludeIDS);
  FreeAndNil(FFormElements);
  inherited Destroy;
end;

procedure THTMLToFormELements.Clear;
begin
  FFormElements.Clear;
end;

procedure THTMLToFormELements.LoadFromStream(aInput: TStream);

var
  MyReader : THTMLReader;

begin
  MyReader:=THTMLReader.Create;
  Try
    MyReader.OnStartElement:=@DoStartElement;
    MyReader.OnEndElement:=@DoEndElement;
    MyReader.ParseStream(aInput);
  finally
    FreeAndNil(MyReader);
  end;
end;

procedure THTMLToFormELements.LoadFromFile(const aFileName: String);
var
  F : TFileStream;
begin
  F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(F);
  finally
    F.Free;
  end;
end;

{ TFormCodeGen }

procedure TFormCodeGen.SetFormElements(AValue: TFormElementList);
begin
  if FFormElements=AValue then Exit;
  FFormElements.Assign(AValue);
end;

function TFormCodeGen.BaseUnits: String;
begin
  Result:='js, web';
end;

class function TFormCodeGen.CreateElementList: TFormElementList;
begin
  Result:=TFormElementList.Create(TFormElement);
end;

constructor TFormCodeGen.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  // Assume class is TComponent descendant
  FConstructorArgs:='aOwner : TComponent';
  FFormElements:=CreateElementList;
  FormClassName:='TMyForm';
  ParentClassName:='TComponent';
  EventSignature:='Event : TJSEvent';
  EventModifiers:='virtual; abstract;';
  GetElementFunction:='document.getelementByID';
  AddMethods:=[smConstructor,smBindElements,smBindElementEvents];
  VirtualMethods:=[smBindElementEvents,smBindElements];
  OverrideMethods:=[smConstructor];
  Options:=[foBindInConstructor];
  fFormFileGenerator:=CreateFormFileGen;
  FFormSource:=TStringList.Create;
end;

destructor TFormCodeGen.Destroy;
begin
  FreeAndNil(FFormSource);
  FreeAndNil(fFormFileGenerator) ;
  FreeAndNil(FFormElements);
  inherited Destroy;
end;

procedure TFormCodeGen.EmitFormElement(aEL : TFormElement);

begin
  With aEl do
    AddLn('%s : %s;',[Name,ElementType]) ;
end;

procedure TFormCodeGen.EmitFormEvents(aEL : TFormElement);

Var
  S,EN,EH : String;

begin
  if not aEl.HasEvents then
    exit;
  For S in aEl.Events do
    begin
    GetEventNameAndHandler(S,aEl.Name,EN,EH);
    Addln('Procedure %s(%s); %s',[EH, EventSignature,EventModifiers]);
    end;
end;

procedure TFormCodeGen.EmitPublishedSection;

var
  I : Integer;

begin
  For I:=0 to FormElements.Count-1 do
    EmitFormElement(FormElements[i]);
  if foEvents in Options then
    For I:=0 to FormElements.Count-1 do
      EmitFormEvents(FormElements[i]);
end;

function TFormCodeGen.VirtualOverride(M: TSpecialMethod; const Decl: String): string;

begin
  Result:=Decl;
  if M in OverrideMethods then
    Result:=Result+' override;'
  else if M in VirtualMethods then
    Result:=Result+' virtual;'
end;

procedure TFormCodeGen.EmitPublicSection;

begin
  if smConstructor in AddMethods then
    Addln(VirtualOverride(smConstructor,'Constructor create('+ConstructorArgs+');'));
  if smBindElements in AddMethods then
  Addln(VirtualOverride(smBindElements, 'Procedure BindElements;'));
  if (smBindElementEvents in AddMethods) and (foEvents in Options) then
    Addln(VirtualOverride(smBindElementEvents,'Procedure BindElementEvents;'));
end;

procedure TFormCodeGen.Execute;

begin
   Source.Clear;
   Addln('unit %s;',[OutputUnitName]);
   CreateHeader;
   Addln('Type');
   Indent;
   ClassHeader(FormClassName);
   AddLn('%s = class(%s) ',[FormClassName,ParentClassName]);
   Addln('Published');
   Indent;
   EmitPublishedSection;
   Undent;
   Addln('Public');
   Indent;
   EmitPublicSection;
   Undent;
   Addln('end;');
   Undent;
   Addln('');
   Addln('implementation');
   AddLn('');
   if (foFormFile in Options) then
     begin
     EmitFormFile;
     AddLn('');
     AddLn('{$R *.dfm}');
     AddLn('');
     end;
   ClassHeader(FormClassName);
   EmitImplementation;
   AddLn('');
   AddLn('end.');
end;

procedure TFormCodeGen.EmitFormFile;

begin
  FormFileGenerator.FormElements:=Self.FormElements;
  FormFileGenerator.DoEvents:=foEvents in Options;
  FormFileGenerator.FormClassName:=Self.FormClassName;
  FormFileGenerator.Execute;
  FormSource.Assign(FormFileGenerator.Source);
end;

function TFormCodeGen.CreateFormFileGen: TFormFileCodeGen;
begin
  Result:=TFormFileCodeGen.Create(Nil);
end;

function TFormCodeGen.CreateHTMLToFormELements: THTMLToFormELements;

begin
  Result:=THTMLToFormELements.Create(Self);
end;


procedure TFormCodeGen.EmitFormConstructor;

begin
  Addln('');
  Addln('Constructor %s.create(aOwner : TComponent);',[FormClassName]);
  if not (foBindInConstructor in Options) then
    SimpleMethodBody(['Inherited;'])
  else
    begin
    if foEvents in Options then
      SimpleMethodBody(['Inherited;','BindElements;','BindElementEvents;'])
    else
      SimpleMethodBody(['Inherited;','BindElements;']);
    end;
  Addln('');
end;

procedure TFormCodeGen.EmitImplementation;

begin
  if smConstructor in AddMethods then
    EmitFormConstructor;
  if (smBindElements in AddMethods) then
    EmitFormBindElements;
  if (foEvents in Options) and Not (foFormFile in Options) and (smBindElementEvents in AddMethods) then
    EmitFormBindEvents;
end;

procedure TFormCodeGen.EmitFormBindElements;

var
  I : integer;
  El : TFormElement;

begin
  Addln('');
  Addln('Procedure %s.BindElements;',[FormClassName]);
  Addln('');
  AddLn('begin');
  Indent;
  if smBindElements in OverrideMethods then
    AddLn('inherited;');
  For I:=0 to FormElements.Count-1 do
    begin
    el:=FormElements[i];
    With El do
      Addln('%s:=%s(%s(''%s''));',[Name,ElementType,GetElementFunction,HTMLID]);
    end;
  Undent;
  Addln('end;');
  Addln('');
end;

class function TFormCodeGen.Pretty(const S: String): string;

begin
  Result:=UpperCase(Copy(S,1,1))+LowerCase(Copy(S,2,Length(S)-1));
end;

class procedure TFormCodeGen.GetEventNameAndHandler(const S,
  aFieldName: String; out aName, aHandler: string);

Var
  P : Integer;

begin
  P:=Pos('=',S);
  if (P=0) then
    P:=Length(S)+1;
  aName:=Copy(S,1,P-1);
  aHandler:=Copy(S,P+1,Length(S)-P);
  if AHandler='' then
    aHandler:=aFieldName+Pretty(aName);
//  Writeln(aFieldName,': ',S,' -> ',aName,' & ',aHandler);
end;


procedure TFormCodeGen.EmitFormBindEvents;

var
  I : integer;
  El : TFormElement;
  S,EN,EH : String;

begin
  Addln('Procedure %s.BindElementEvents;',[FormClassName]);
  Addln('');
  AddLn('begin');
  Indent;
  if smBindElementEvents in OverrideMethods then
    AddLn('inherited;');
  For I:=0 to FormElements.Count-1 do
    begin
    el:=FormElements[i];
    With El do
      if HasEvents then
        For S in El.Events do
          begin
          GetEventNameAndHandler(S,Name,EN,EH);
          Addln('%s.AddEventListener(''%s'',@%s);',[Name,EN,EH]);
          end;
    end;
  Undent;
  Addln('end;');
end;

{ TFormElementList }

function TFormElementList.GetEl(aIndex : Integer): TFormElement;
begin
  Result:=Items[aIndex] as TFormElement;
end;

function TFormElementList.Add(const aName: string): TFormElement;
begin
  if IndexOf(aName)<>-1 then
    Raise Exception.CreateFmt('Duplicate name : %s' ,[aName]);
  Result:=(Inherited Add) as TFormElement;
  Result.Name:=aName;
end;

function TFormElementList.IndexOf(const aName: string): Integer;
begin
  Result:=Count-1;
  While (Result>=0) and Not SameText(aName,GetEl(Result).Name) do
    Dec(Result);
end;

function TFormElementList.Find(const aName: string): TFormElement;

var
  Idx : Integer;

begin
  Idx:=IndexOf(aName);
  if Idx>=0 then
    Result:=GetEl(Idx)
  else
    Result:=Nil;
end;

{ TFormElement }

function TFormElement.GetEvents: TStrings;
begin
  If (FEvents=Nil) then
    FEvents:=TStringList.Create;
  Result:=FEvents;
end;

function TFormElement.getName: String;
begin
  Result:=FName;
  if Result='' then
    Result:=HTMLID;
end;

procedure TFormElement.SetEvents(AValue: TStrings);
begin
  If AValue=FEVents then exit;
  Events.Assign(aValue);
end;

destructor TFormElement.Destroy;
begin
  FreeAndNil(FEvents);
  inherited Destroy;
end;

function TFormElement.HasEvents: Boolean;
begin
  Result:=Assigned(FEvents) and (FEvents.Count>0);
end;

procedure TFormElement.Assign(Source: TPersistent);

Var
  FE : TFormElement absolute Source;

begin
  if Source is TFormElement then
    begin
    FHTMLID:=FE.HTMLID;
    FName:=FE.FName;
    FType:=FE.FType;
    if FE.HasEvents then
      Events:=FE.Events;
    end
  else
    inherited Assign(Source);
end;

end.