paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-21 13:59:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

* HTML To form tool committed

Browse Source
This commit is contained in:
michael 2020-08-29 07:10:28 +00:00
parent b141aed060
commit d81f905639
9 changed files with 1661 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
demo/resources/consoledemo.lpi
View File

@ -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>

20
demo/resources/htmldemo.lpi
View File

@ -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>

2
demo/resources/htmldemo.lpr
View File

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

12
test/testrtl.lpr
View File

@ -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
tools/html2form/formgen.pas Normal file
View File

File diff suppressed because it is too large Load Diff

63
tools/html2form/htmltoform.lpi Normal file
View File

@ -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
tools/html2form/htmltoform.lpr Normal file
View File

@ -0,0 +1,171 @@
{
Copyright (c) 2020 by Michael Van Canneyt michael@freepascal.org
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
tools/html2form/webcore.map Normal file
View File

@ -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
tools/html2form/webcoreformgen.pp Normal file
View File

@ -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.