Browse Source

* HTML To form tool committed

michael 4 years ago
parent
commit
d81f905639

+ 8 - 10
demo/resources/consoledemo.lpi

@@ -23,7 +23,6 @@
     </PublishOptions>
     <RunParams>
       <FormatVersion Value="2"/>
-      <Modes Count="0"/>
     </RunParams>
     <Units>
       <Unit>
@@ -38,7 +37,6 @@
       <Filename Value="consoledemo"/>
     </Target>
     <SearchPaths>
-      <IncludeFiles Value="$(ProjOutDir)"/>
       <UnitOutputDirectory Value="js"/>
     </SearchPaths>
     <Parsing>
@@ -58,21 +56,21 @@
       </Debugging>
     </Linking>
     <Other>
-      <CustomOptions Value="-Jeutf-8 -Jminclude -Jirtl.js -JRjs"/>
+      <CustomOptions Value="-Jeutf-8 -Jminclude"/>
       <CompilerPath Value="$(pas2js)"/>
     </Other>
   </CompilerOptions>
   <Debugging>
-    <Exceptions Count="3">
-      <Item1>
+    <Exceptions>
+      <Item>
         <Name Value="EAbort"/>
-      </Item1>
-      <Item2>
+      </Item>
+      <Item>
         <Name Value="ECodetoolError"/>
-      </Item2>
-      <Item3>
+      </Item>
+      <Item>
         <Name Value="EFOpenError"/>
-      </Item3>
+      </Item>
     </Exceptions>
   </Debugging>
 </CONFIG>

+ 9 - 11
demo/resources/htmldemo.lpi

@@ -28,13 +28,11 @@
     </PublishOptions>
     <RunParams>
       <FormatVersion Value="2"/>
-      <Modes Count="0"/>
     </RunParams>
     <Units>
       <Unit>
         <Filename Value="htmldemo.lpr"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="consoledemo"/>
       </Unit>
       <Unit>
         <Filename Value="htmldemo.html"/>
@@ -47,7 +45,7 @@
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="11"/>
-    <Target FileExt=".js">
+    <Target>
       <Filename Value="htmldemo"/>
     </Target>
     <SearchPaths>
@@ -71,21 +69,21 @@
       </Debugging>
     </Linking>
     <Other>
-      <CustomOptions Value="-Jeutf-8 -Jirtl.js -Jc -Jminclude -JRjs"/>
+      <CustomOptions Value="-Jeutf-8 -Jirtl.js -Jc  -JRjs"/>
       <CompilerPath Value="$(pas2js)"/>
     </Other>
   </CompilerOptions>
   <Debugging>
-    <Exceptions Count="3">
-      <Item1>
+    <Exceptions>
+      <Item>
         <Name Value="EAbort"/>
-      </Item1>
-      <Item2>
+      </Item>
+      <Item>
         <Name Value="ECodetoolError"/>
-      </Item2>
-      <Item3>
+      </Item>
+      <Item>
         <Name Value="EFOpenError"/>
-      </Item3>
+      </Item>
     </Exceptions>
   </Debugging>
 </CONFIG>

+ 1 - 1
demo/resources/htmldemo.lpr

@@ -1,4 +1,4 @@
-program consoledemo;
+program htmldemo;
 
 {$mode objfpc}
 

+ 6 - 6
test/testrtl.lpr

@@ -26,13 +26,13 @@ program testrtl;
 
 uses
   browserconsole, consoletestrunner, frmrtlrun, simplelinkedlist,
-  tcstream, tccompstreaming,
-    tcsyshelpers,
+//  tcstream, tccompstreaming,
+//  tcsyshelpers,
 //  tcgenarrayhelper,
-    tcstringhelp,
-    tcgenericdictionary,
-    tcgenericlist,
-    tcgenericqueue,
+//    tcstringhelp,
+//    tcgenericdictionary,
+//    tcgenericlist,
+//    tcgenericqueue,
     tcgenericstack,
     strutils,
     sysutils;

+ 1128 - 0
tools/html2form/formgen.pas

@@ -0,0 +1,1128 @@
+{
+    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.
+

+ 63 - 0
tools/html2form/htmltoform.lpi

@@ -0,0 +1,63 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+        <CompatibilityMode Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="My Application"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="htmltoform.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="formgen.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="webcoreformgen.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="htmltoform"/>
+    </Target>
+    <SearchPaths>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 171 - 0
tools/html2form/htmltoform.lpr

@@ -0,0 +1,171 @@
+{
+    Copyright (c) 2020 by Michael Van Canneyt [email protected]
+    This file is part of the pas2js toolset
+
+    HTML to pascal code converter program
+
+    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.
+
+ **********************************************************************}
+
+program htmltoform;
+
+uses sysutils, classes, sax,sax_html, custapp, formgen, webcoreformgen;
+
+Type
+
+  { THTML2FormApplication }
+
+  THTML2FormApplication = Class(TCustomApplication)
+  Private
+    FConv: THTMLToFormELements ;
+    FGen : TWebCoreFormCodeGen;
+    procedure ReadConfigFile(const aFileName: String);
+    procedure Usage(S: String);
+    procedure WriteLog(Sender: TObject; const Msg: String);
+  Protected
+    Procedure DoRun; override;
+  Public
+    Constructor Create(aOwner: TComponent); override;
+    Destructor Destroy; override;
+  end;
+
+
+{ TMyApp }
+
+procedure THTML2FormApplication.Usage(S : String);
+
+begin
+  if S<>'' then
+    Writeln('Error : ',S);
+  Writeln('Usage : ',ExtractFileName(ExeName),' -i file -o file [options]');
+  Writeln('Where options is one or more of: ');
+  Writeln('-h --help                    this message');
+  Writeln('-b --below-id=ID             Only create elements for child elements of element ID');
+  Writeln('-f --formclass=NAME          name of pascal form class');
+  Writeln('-F --form-file               Generate a form file.');
+  Writeln('-g --getelementfunction=NAME Name of getelement function');
+  Writeln('-e --events                  emit code to bind events');
+  Writeln('-i --input=file              html file to read');
+  writeln('-m --map=file                read tag to pascal class map from file');
+  writeln('-n --no-bind                 Do not call bindelements in constructor');
+  writeln('-o --output=file             pascal file to write');
+  Writeln('-p --parentclass=NAME        name of pascal form parent class');
+  Writeln('-x --exclude=List            Comma-separated list of IDs to exclude. if starts with @, then load from file');
+  Halt(Ord(S<>''));
+end;
+
+procedure THTML2FormApplication.WriteLog(Sender: TObject; const Msg: String);
+begin
+  Writeln(Msg);
+end;
+
+procedure THTML2FormApplication.ReadConfigFile(const aFileName : String);
+
+begin
+
+end;
+
+procedure THTML2FormApplication.DoRun;
+
+var
+  S,IFN,OFN : String;
+begin
+  StopOnException:=True;
+  Terminate;
+  S:=CheckOptions('c:hi:o:f:ep:b:g:x:m:Fndqa',
+                  ['config:','help','input:','output:','formclass:','event',
+                   'parentclass:','below-id:','getelementfunction:','exclude:',
+                   'map:','form-file','no-bind','defaultelements','quiet','actionlist']);
+  if (S<>'') or HasOption('h','help') then
+    Usage(S);
+  IFN:=GetOptionValue('i','input');
+  OFN:=GetOptionValue('o','output');
+  FConv.DefaultElements:=HasOption('d','defaultelements');
+  if HasOption('c','config') then
+    ReadConfigFile(GetOptionValue('c','config'));
+  if HasOption('f','formclass') then
+    FGen.FormClassName:=GetOptionValue('f','formclass');
+  if HasOption('p','parentclass') then
+    FGen.ParentClassName:=GetOPtionValue('p','parentclass');
+  if HasOption('g','getelementfunction') then
+    FGen.GetElementFunction:=GetOptionValue('g','getelementfunction') ;
+  if HasOption('F','form-file') or hasOption('a','actionlist') then
+    begin
+    FGen.Options:=FGen.Options+[foFormFile];
+    FGen.EventSignature:='Sender : TObject';
+    FGen.EventModifiers:='';
+    FGen.AddMethods:=[];
+    if hasOption('a','actionlist') then
+      FGen.WebCoreOptions:=FGen.WebCoreOptions+[wcoUseActionList];
+    end;
+  if hasOption('e','event') then
+    FGen.Options:=FGen.Options+[foEvents];
+  if hasOption('n','no-bind') then
+    FGen.Options:=FGen.Options-[foBindInConstructor];
+  if HasOption('m','map') then
+    begin
+    FConv.Map.LoadFromFile(GetOptionValue('m','map'));
+    FConv.DefaultElements:=HasOption('d','defaultelements');
+    end;
+  if Not HasOption('q','quiet') then
+    FCOnv.OnLog:=@WriteLog;
+  if HasOption('x','exclude') then
+    begin
+    S:=GetOPtionValue('x','exclude');
+    if (S<>'') and (S[1]='@') then
+      FConv.ExcludeIDS.LoadFromFile(Copy(S,2,Length(S)-1))
+    else
+      FConv.ExcludeIDS.CommaText:=S;
+    end;
+  if HasOption('b','below-id') then
+    FConv.BelowID:=GetOptionValue('b','below-id');
+  if IFN='' then
+    Usage('Need input file');
+  if OFN='' then
+    Usage('Need output file');
+  FConv.LoadFromFile(IFN);
+  if FConv.FormElements.Count=0 then
+    Writeln('No elements found')
+  else
+    begin
+    FGen.FormElements:=FConv.FormElements;
+    FGen.OutputUnitName:=ChangeFileExt(ExtractFIleName(ofn),'');
+    FGen.Execute;
+    FGen.SaveToFile(OFN);
+    if foFormFile in FGen.Options then
+      FGen.FormSource.SaveToFile(ChangeFileExt(OFN,'.dfm'));
+    end;
+end;
+
+constructor THTML2FormApplication.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+  FConv:=THTMLToFormELements.Create(Self);
+  FGen:=TWebCoreFormCodeGen.Create(Self);
+end;
+
+destructor THTML2FormApplication.Destroy;
+begin
+  FreeAndNil(FGen);
+  FreeAndNil(FConv);
+  inherited Destroy;
+end;
+
+
+begin
+  With THTML2FormApplication.Create(Nil) do
+    try
+      Initialize;
+      Run;
+    finally
+      Free;
+    end;
+
+end.
+

+ 79 - 0
tools/html2form/webcore.map

@@ -0,0 +1,79 @@
+[
+  { 
+    "tag" : "input",
+    "attrs" : { "type" : "text" },
+    "class" : "TWebEdit"
+  },
+  { 
+    "tag" : "input",
+    "attrs" : { "type" : "checkbox" },
+    "class" : "TWebCheckBox"
+  },
+  { 
+    "tag" : "input",
+    "attrs" : { "type" : "radio" },
+    "class" : "TWebRadioButton"
+  },
+  { 
+    "tag" : "input",
+    "attrs" : { "type" : "submit" },
+    "class" : "TWebButton"
+  },
+  { 
+    "tag" : "input",
+    "attrs" : { "type" : "reset" },
+    "class" : "TWebButton"
+  },
+  { 
+    "tag" : "input",
+    "attrs" : { "type" : "image" },
+    "class" : "TWebButton"
+  },
+  { 
+    "tag" : "input",
+    "attrs" : { "type" : "button" },
+    "class" : "TWebButton"
+  },
+  { 
+    "tag" : "input",
+    "class" : "TWebEdit"
+  },
+  { 
+    "tag" : "textarea",
+    "class" : "TWebMemo"
+  },
+  { 
+    "tag" : "select",
+    "attrs" : { "multiple" : "" },
+    "class" : "TWebComboBox"
+  },
+  { 
+    "tag" : "select",
+    "class" : "TWebComboBox"
+  },
+  { 
+    "tag" : "div",
+    "class" : "TWebHTMLDiv"
+  },
+  { 
+    "tag" : "span",
+    "class" : "TWebHTMLSpan"
+  },
+  { 
+    "tag" : "a",
+    "class" : "TWebHTMLAnchor"
+  },
+  { 
+    "tag" : "form",
+    "class" : "TWebHTMLForm"
+  },
+  { 
+    "tag" : "button",
+    "class" : "TWebButton"
+  },
+  { 
+    "tag" : "small",
+    "class" : ""
+  }
+  
+]

+ 196 - 0
tools/html2form/webcoreformgen.pp

@@ -0,0 +1,196 @@
+{
+    This file is part of the Pas2JS tool chain
+    Copyright (c) 2020 by Michael Van Canneyt
+
+    This unit implements a HTML to DFM/LFM generator
+
+    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 webcoreformgen;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, formgen;
+
+type
+  TWebCoreFormFileCodeGen = Class;
+
+  { TWebCoreFormCodeGen }
+  TWebCoreOption = (wcoUseActionList);
+  TWebCoreOptions = set of TWebCoreOption;
+
+
+  TWebCoreFormCodeGen = Class(TFormCodeGen)
+  private
+    FListClassName: String;
+    FListInstanceName: String;
+    FWebCoreOptions: TWebCoreOptions;
+    function GetWFF: TWebCoreFormFileCodeGen;
+    procedure SetListClassName(AValue: String);
+    procedure SetListInstanceName(AValue: String);
+    procedure SetWebCoreOptions(AValue: TWebCoreOptions);
+  Protected
+    procedure EmitPublishedSection; override;
+    function CreateFormFileGen : TFormFileCodeGen; override;
+    Property WebFormFile : TWebCoreFormFileCodeGen Read GetWFF;
+  Published
+    Property WebCoreOptions : TWebCoreOptions Read FWebCoreOptions Write SetWebCoreOptions;
+    Property ListClassName : String Read FListClassName Write SetListClassName;
+    Property ListInstanceName : String Read FListInstanceName Write SetListInstanceName;
+  end;
+
+  { TWebCoreFormFileCodeGen }
+
+  TWebCoreFormFileCodeGen = Class(TFormFileCodeGen)
+  private
+    FListClassName: String;
+    FListInstanceName: String;
+    FWebCoreOptions: TWebCoreOptions;
+    procedure EmitItem(el: TFormElement; aEvent, aHandler: String);
+    procedure GenerateListItems;
+  Protected
+    Procedure GenerateElements; override;
+  Public
+    Constructor create(aOwner : TComponent); override;
+  Published
+    Property WebCoreOptions : TWebCoreOptions Read FWebCoreOptions Write FWebCoreOptions;
+    Property ListClassName : String Read FListClassName Write FListClassName;
+    Property ListInstanceName : String Read FListInstanceName Write FListInstanceName;
+  end;
+
+implementation
+
+{ TWebCoreFormFileCodeGen }
+
+procedure TWebCoreFormFileCodeGen.EmitItem(el : TFormElement; aEvent,aHandler : String);
+
+
+begin
+  AddLn('item');
+  Indent;
+  AddLn('ID = ''%s''',[el.HTMLID]);
+  if (aEvent<>'') then
+    begin
+    Addln('Event = %s',[aEvent]);
+    if (aHandler<>'') then
+      AddLn('OnExecute = %s',[aHandler]);
+    end;
+  AddLn('TargetAction = actNone');
+  Undent;
+  AddLn('end');
+end;
+
+procedure TWebCoreFormFileCodeGen.GenerateListItems;
+
+
+
+Var
+  I : Integer;
+  El : TFormElement;
+  S,EN,EH : String;
+
+begin
+  Addln('Actions = <');
+  Indent;
+  For I:=0 to FormElements.Count-1 do
+    begin
+    el:=FormElements[i];
+    // Web Core does not support multiple events on 1 webaction,
+    // So, we must generate 1 item per event.
+    if DoEvents and (El.Events.Count>0) then
+      begin
+      For S in El.Events do
+        begin
+        TFormCodeGen.GetEventNameAndHandler(S,El.Name,EN,EH);
+        EmitItem(El,EN,EH);
+        end;
+      end
+    else
+      EmitItem(El,'','');
+    end;
+  Undent;
+  Addln('>');
+end;
+
+procedure TWebCoreFormFileCodeGen.GenerateElements;
+
+begin
+  if wcoUseActionList in WebcoreOptions then
+    begin
+    AddLn('object %s : %s',[ListInstanceName,ListClassName]);
+    Indent;
+    GenerateListItems;
+    Undent;
+    AddLn('end');
+    end
+  else
+    inherited GenerateElements;
+end;
+
+constructor TWebCoreFormFileCodeGen.create(aOwner: TComponent);
+begin
+  inherited create(aOwner);
+  ListInstanceName:='Elements';
+  ListClassName:='TWebElementActionList';
+end;
+
+{ TWebCoreFormCodeGen }
+
+procedure TWebCoreFormCodeGen.SetWebCoreOptions(AValue: TWebCoreOptions);
+begin
+  if FWebCoreOptions=AValue then Exit;
+  FWebCoreOptions:=AValue;
+  WebFormFile.WebCoreOptions:=aValue;
+  if wcoUseActionList in aValue then
+    begin
+    EventSignature:='Sender: TObject; Element: TJSHTMLElementRecord; Event: TJSEventParameter';
+    EventModifiers:='';
+    end;
+end;
+
+function TWebCoreFormCodeGen.GetWFF: TWebCoreFormFileCodeGen;
+begin
+  Result:=Self.FormFileGenerator as TWebCoreFormFileCodeGen;
+end;
+
+procedure TWebCoreFormCodeGen.SetListClassName(AValue: String);
+begin
+  if FListClassName=AValue then Exit;
+  FListClassName:=AValue;
+  WebFormFile.ListClassName:=aValue;
+end;
+
+procedure TWebCoreFormCodeGen.SetListInstanceName(AValue: String);
+begin
+  if FListInstanceName=AValue then Exit;
+  FListInstanceName:=AValue;
+  WebFormFile.ListInstanceName:=aValue;
+end;
+
+procedure TWebCoreFormCodeGen.EmitPublishedSection;
+begin
+  if wcoUseActionList in WebcoreOptions then
+    begin
+    AddLn('%s : %s;',[ListInstanceName,ListClassName]);
+    end
+  else
+    inherited EmitPublishedSection;
+end;
+
+function TWebCoreFormCodeGen.CreateFormFileGen: TFormFileCodeGen;
+begin
+  Result:=TWebCoreFormFileCodeGen.Create(Nil);
+end;
+
+end.
+