diff --git a/tools/html2form/formgen.pas b/tools/html2form/formgen.pas index 97e2b99..809ae97 100644 --- a/tools/html2form/formgen.pas +++ b/tools/html2form/formgen.pas @@ -1,17 +1,3 @@ -{ - 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+} @@ -19,7 +5,57 @@ unit formgen; interface uses - Classes, SysUtils, sax, sax_html, pascodegen, fpjson, jsonparser; + Classes, SysUtils, sax, sax_html, fpjson, pascodegen; + +Type + TSpecialMethod = (smConstructor,smBindElements,smBindElementEvents); + TSpecialMethods = Set of TSpecialMethod; + + TFormOption = (foEvents,foFormFile,foBindInConstructor); + TFormOptions = Set of TFormOption; + + + { THTML2ClassOptions } + + THTML2ClassOptions = Class (TPersistent) + Private + FExcludeElements: TStrings; + FFormOptions: TFormOptions; + FMethods : Array[1..3] of TSpecialMethods; + FBools : Array[1..2] of Boolean; + FStrings : Array[1..10] of String; + function GetB(AIndex: Integer): Boolean; + function GetMethods(AIndex: Integer): TSpecialMethods; + function GetS(AIndex: Integer): String; + procedure SetB(AIndex: Integer; AValue: Boolean); + procedure SetExcludeElements(AValue: TStrings); + procedure SetMethods(AIndex: Integer; AValue: TSpecialMethods); + procedure SetS(AIndex: Integer; AValue: String); + Public + Constructor Create; + Destructor Destroy; override; + Procedure Reset; virtual; + Procedure toJSON(aObject : TJSONObject); + Procedure FromJSON(aObject : TJSONObject); + Function asJSON(Formatted : Boolean) : String; + Property OverrideMethods : TSpecialMethods index 1 Read GetMethods Write SetMethods; + Property AddMethods : TSpecialMethods index 2 Read GetMethods Write SetMethods; + Property VirtualMethods : TSpecialMethods index 3 Read GetMethods Write SetMethods; + Property FormOptions : TFormOptions Read FFormOptions Write FFormOptions; + Property ParentClassName : String Index 1 Read GetS Write SetS; + Property GetElementFunction : String Index 2 Read GetS Write SetS; + Property EventSignature : String Index 3 Read GetS Write SetS; + Property EventModifiers : String Index 4 Read GetS Write SetS; + Property ConstructorArgs : String Index 5 Read GetS Write SetS; + Property BelowID : String Index 6 Read GetS Write SetS; + Property HTMLFileName : String Index 7 Read GetS Write SetS; + Property TagMapFileName : String Index 8 Read GetS Write SetS; + Property FormClassname : String Index 9 Read GetS Write SetS; + Property ExtraUnits: String index 10 Read GetS Write SetS; + Property UseDefaultElements : Boolean Index 1 Read GetB Write SetB; + Property AddHTMLToProject : Boolean Index 2 Read GetB Write SetB; + Property ExcludeElements : TStrings Read FExcludeElements Write SetExcludeElements; + end; Type TLogEvent = Procedure (Sender : TObject; Const Msg : String) of object; @@ -57,8 +93,8 @@ Type Function Find(Const aName : string) : TFormElement; Property Elements[aIndex : Integer] : TFormElement Read GetEl; default; end; - - TAttributeOperation = (aoNotPresent,aoPresent,aoEqual,aoNotEqual,aoContains); + + TAttributeOperation = (aoNotPresent,aoPresent,aoEqual,aoNotEqual,aoContains); { TAttributeCondition } @@ -74,7 +110,7 @@ Type Property Operation : TAttributeOperation Read FOperation Write FOperation; Property Value : String Read FValue Write FValue; end; - + { TAttributeConditionList } TAttributeConditionList = Class(TCollection) @@ -85,7 +121,7 @@ Type Function IsMatch(Attrs: TSAXAttributes): Boolean; Property Conditions[aIndex : Integer] : TAttributeCondition Read GetC; default; end; - + (* // Structure of accepted JSON [ { @@ -94,7 +130,7 @@ Type "attrs" : { name0 : null, // name0 Not present name1 : "value", // name1 equals value - name2 ; "-value", // name2 does not equal value + name2 ; "-value", // name2 does not equal value name3 : "~value" // name3 contains value } } @@ -134,7 +170,7 @@ Type Function FindMap(aTag: SAXString; Attrs: TSAXAttributes): THTMLElementMap; Property Maps[aIndex : Integer] : THTMLElementMap Read GetM; default; end; - + { THTMLToFormELements } @@ -168,6 +204,7 @@ Type Procedure Clear; Procedure LoadFromStream(aInput : TStream); Procedure LoadFromFile(Const aFileName : String); + Procedure LoadOptions(aOptions : THTML2ClassOptions); Property FormElements : TFormElementList Read FFormElements Write SetFormElements; Property BelowID : String Read FBelowID Write FBelowID; Property ExcludeIDS : TStrings Read FExcludeIDS Write SetExcludeIDS; @@ -178,10 +215,7 @@ Type { TFormCodeGen } - TSpecialMethod = (smConstructor,smBindElements,smBindElementEvents); - TSpecialMethods = Set of TSpecialMethod; - TFormOption = (foEvents,foFormFile,foBindInConstructor); - TFormOptions = Set of TFormOption; + { TFormFileCodeGen } @@ -230,7 +264,7 @@ Type FEventSignature: string; FFormClassName: string; FFormElements: TFormElementList; - fFormFileGenerator: TFormFileCodeGen; + FFormFileGenerator: TFormFileCodeGen; FFormSource: Tstrings; FGetElementFunction: string; FOptions: TFormOptions; @@ -259,6 +293,7 @@ Type class function Pretty(const S: String): string; virtual; class procedure GetEventNameAndHandler(const S,aFieldName: String; out aName, aHandler: string); Procedure Execute; + Procedure LoadOptions(aOptions : THTML2ClassOptions); Property FormFileGenerator : TFormFileCodeGen Read fFormFileGenerator Write FFormFileGenerator; Property FormElements : TFormElementList Read FFormElements Write SetFormElements; Property FormClassName : string Read FFormClassName Write FFormClassName; @@ -274,8 +309,224 @@ Type Property FormSource : Tstrings Read FFormSource; end; + + implementation +uses TypInfo; + +{ ---------------------------------------------------------------------- + + ----------------------------------------------------------------------} + +{ THTML2ClassOptions } + +function THTML2ClassOptions.GetB(AIndex: Integer): Boolean; +begin + Result:=FBools[aindex]; +end; + +function THTML2ClassOptions.GetMethods(AIndex: Integer): TSpecialMethods; +begin + Result:=FMethods[aindex]; +end; + +function THTML2ClassOptions.GetS(AIndex: Integer): String; +begin + Result:=FStrings[aindex]; +end; + +procedure THTML2ClassOptions.SetB(AIndex: Integer; AValue: Boolean); +begin + FBools[aIndex]:=aValue; +end; + +procedure THTML2ClassOptions.SetExcludeElements(AValue: TStrings); +begin + if FExcludeElements=AValue then Exit; + FExcludeElements.Assign(AValue); +end; + +procedure THTML2ClassOptions.SetMethods(AIndex: Integer; AValue: TSpecialMethods); +begin + FMethods[aIndex]:=aValue; +end; + +procedure THTML2ClassOptions.SetS(AIndex: Integer; AValue: String); +begin + FStrings[aIndex]:=aValue; +end; + +constructor THTML2ClassOptions.Create; +begin + FExcludeElements:=TStringList.Create; + Reset; +end; + +destructor THTML2ClassOptions.Destroy; +begin + FreeAndNil(FExcludeElements); + inherited Destroy; +end; + +procedure THTML2ClassOptions.Reset; +begin + // Assume class is TComponent descendant + ConstructorArgs:='aOwner : TComponent'; + FormClassName:='TMyForm'; + ParentClassName:='TComponent'; + EventSignature:='Event : TJSEvent'; + EventModifiers:='virtual; abstract;'; + GetElementFunction:='document.getelementByID'; + AddMethods:=[smConstructor,smBindElements,smBindElementEvents]; + VirtualMethods:=[smBindElementEvents,smBindElements]; + OverrideMethods:=[smConstructor]; + FormOptions:=[foBindInConstructor]; + FExcludeElements.Clear; + ExtraUnits:='Classes' +end; + +procedure THTML2ClassOptions.toJSON(aObject: TJSONObject); + + Function GenToArray(aMethods : TSpecialMethods) : TJSONArray; + + Var + M : TSpecialMethod; + + begin + Result:=TJSONArray.Create; + For M in TSpecialMethods do + If M in aMethods then + Result.Add(GetEnumName(TypeInfo(TSpecialMethod),Ord(M))); + end; + + Function OptionsToArray(aOptions : TFormOptions) : TJSONArray; + + Var + F : TFormOption; + + begin + Result:=TJSONArray.Create; + For F in TFormOptions do + If F in aOptions then + Result.Add(GetEnumName(TypeInfo(TFormOptions),Ord(F))); + end; + + +Var + arr : TJSONArray; + S : String; + +begin + With aObject do + begin + Add('OverrideMethods',GenToArray(OverrideMethods)); + Add('AddMethods',GenToArray(AddMethods)); + Add('VirtualMethods',GenToArray(VirtualMethods)); + Add('FormOptions',OptionsToArray(FormOptions)); + Add('GetElementFunction',GetElementFunction); + Add('EventSignature',EventSignature); + Add('EventModifiers',EventModifiers); + Add('ConstructorArgs',ConstructorArgs); + Add('BelowID',BelowID); + Add('HTMLFileName',HTMLFileName); + Add('FormClassname',FormClassname); + Add('FormClassname',FormClassname); + Add('UseDefaultElements',UseDefaultElements); + Add('AddHTMLToProject',AddHTMLToProject); + arr:=TJSONArray.Create; + Add('ExcludeElements',Arr); + For S in ExcludeElements do + arr.Add(S); + end; +end; + +procedure THTML2ClassOptions.FromJSON(aObject: TJSONObject); + + Function GenFromArray(Arr : TJSONArray) : TSpecialMethods; + + Var + I,Idx : integer; + + begin + Result:=[]; + if Assigned(Arr) then + For I:=0 to Arr.Count-1 do + if (Arr.types[I]=jtString) then + begin + Idx:=GetEnumValue(TypeInfo(TSpecialMethod),Arr.Strings[I]); + If Idx<>-1 then + include(Result,TSpecialMethod(Idx)); + end; + end; + + Function OptionsFromArray(arr : TJSONArray) : TFormOptions; + + Var + I,Idx : integer; + + begin + Result:=[]; + if Assigned(Arr) then + For I:=0 to Arr.Count-1 do + if (Arr.types[I]=jtString) then + begin + Idx:=GetEnumValue(TypeInfo(TFormOption),Arr.Strings[I]); + If Idx<>-1 then + include(Result,TFormOption(Idx)); + end; + end; + +Var + arr : TJSONArray; + I : integer; + +begin + With aObject do + begin + OverrideMethods:=GenFromArray(Get('OverrideMethods',TJSONArray(Nil))); + AddMethods:=GenFromArray(Get('AddMethods',TJSONArray(Nil))); + VirtualMethods:=GenFromArray(Get('VirtualMethods',TJSONArray(Nil))); + FormOptions:=OptionsFromArray(Get('FormOptions',TJSONArray(Nil))); + GetElementFunction:=Get('GetElementFunction',''); + EventSignature:=Get('EventSignature',''); + EventModifiers:=Get('EventModifiers',''); + ConstructorArgs:=Get('ConstructorArgs',''); + BelowID:=Get('BelowID',''); + HTMLFileName:=Get('HTMLFileName',''); + FormClassname:=Get('FormClassname',''); + UseDefaultElements:=Get('UseDefaultElements',False); + AddHTMLToProject:=Get('AddHTMLToProject',False); + ExcludeElements.Clear; + Arr:=Get('ExcludeElements',TJSONArray(Nil)); + if Assigned(Arr) then + For I:=0 to Arr.Count-1 do + if (Arr.types[I]=jtString) then + ExcludeElements.Add(Arr.Strings[I]); + end; + +end; + +function THTML2ClassOptions.asJSON(Formatted: Boolean): String; + +Var + J : TJSONObject; + +begin + J:=TJSONObject.Create; + try + ToJSON(J); + if Formatted then + Result:=J.FormatJSON() + else + Result:=J.asJSON; + finally + J.Free; + end; +end; + + + { TFormFileCodeGen } function TFormFileCodeGen.GetFormName(const aClassName: string): String; @@ -773,6 +1024,15 @@ begin end; end; +procedure THTMLToFormELements.LoadOptions(aOptions: THTML2ClassOptions); +begin + BelowID:=aoptions.BelowID; + ExcludeIDS:=aOptions.ExcludeElements; + DefaultElements:=aOptions.UseDefaultElements; + if (aOptions.TagMapFileName<>'') and FileExists(aOptions.TagMapFileName) then + Map.LoadFromFile(aOptions.TagMapFileName); +end; + { TFormCodeGen } procedure TFormCodeGen.SetFormElements(AValue: TFormElementList); @@ -792,22 +1052,24 @@ begin end; constructor TFormCodeGen.Create(aOwner: TComponent); + +Var + Defs : THTML2ClassOptions; + 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; + FFormFileGenerator:=CreateFormFileGen; FFormSource:=TStringList.Create; + // Defaults must be set in + Defs:=THTML2ClassOptions.Create; + try + Defs.Reset; + Loadoptions(Defs); + + finally + Defs.Free; + end; end; destructor TFormCodeGen.Destroy; @@ -910,6 +1172,21 @@ begin AddLn('end.'); end; +procedure TFormCodeGen.LoadOptions(aOptions: THTML2ClassOptions); +begin + ExtraUnits:=aOptions.ExtraUnits; + FormClassName:=aOptions.FormClassname; + ParentClassName:=aOptions.ParentClassName; + GetElementFunction:=aOptions.GetElementFunction; + EventSignature:=aOptions.EventSignature; + EventModifiers:=aOptions.EventModifiers; + ConstructorArgs:=aOptions.ConstructorArgs; + Options:=aOptions.FormOptions; + AddMethods:=aOptions.AddMethods; + OverrideMethods:=aOptions.OverrideMethods; + VirtualMethods:=aOptions.VirtualMethods; +end; + procedure TFormCodeGen.EmitFormFile; begin @@ -936,7 +1213,7 @@ procedure TFormCodeGen.EmitFormConstructor; begin Addln(''); - Addln('Constructor %s.create(aOwner : TComponent);',[FormClassName]); + Addln('Constructor %s.create(%s);',[FormClassName,ConstructorArgs]); if not (foBindInConstructor in Options) then SimpleMethodBody(['Inherited;']) else @@ -1124,5 +1401,6 @@ begin inherited Assign(Source); end; + end. diff --git a/tools/html2form/htmltoform.lpr b/tools/html2form/htmltoform.lpr index 2193ab3..e4f1d40 100644 --- a/tools/html2form/htmltoform.lpr +++ b/tools/html2form/htmltoform.lpr @@ -15,7 +15,7 @@ program htmltoform; -uses sysutils, classes, sax,sax_html, custapp, formgen, webcoreformgen; +uses sysutils, classes, fpjson, jsonparser, sax,sax_html, custapp, formgen, webcoreformgen; Type @@ -67,8 +67,30 @@ end; procedure THTML2FormApplication.ReadConfigFile(const aFileName : String); -begin +Var + D : TJSONData; + J : TJSONObject absolute D; + F : TFileStream; + H : THTML2ClassOptions; +begin + D:=Nil; + H:=nil; + F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite); + try + D:=GetJSON(F); + if D is TJSONObject then + begin + H:=THTML2ClassOptions.Create; + H.FromJSON(J); + FConv.LoadOptions(H); + FGen.LoadOptions(H); + end; + finally + H.Free; + F.Free; + D.Free; + end; end; procedure THTML2FormApplication.DoRun;