diff --git a/components/pas2js/idehtml2class.pas b/components/pas2js/idehtml2class.pas
index 50bf3bda7c..f82c8f3b65 100644
--- a/components/pas2js/idehtml2class.pas
+++ b/components/pas2js/idehtml2class.pas
@@ -216,24 +216,76 @@ Type
{ THTMLExtractIDS }
+ TExtractOption = (eoExtraInfo // Add info object with Tag. In stringarray, emit ID=Info.ToString
+ );
+
+ { TTagInfo - attached to string in objects }
+
+ TTagInfo = Class(TObject)
+ private
+ FInputName: String;
+ FInputType: String;
+ FTag: String;
+ Public
+ Constructor Create(Const aTag,aType,aName : String);
+ Function ToString : String; override;
+ Property TagName : String Read FTag Write FTag;
+ Property InputType : String Read FInputType Write FInputType;
+ Property InputName : String Read FInputName Write FInputName;
+ end;
+
+ { TTagInfoItem }
+
+ TTagInfoItem = Class(TCollectionItem)
+ private
+ FElementID: UTF8String;
+ FInputName: UTF8String;
+ FInputType: UTF8String;
+ FTagName: UTF8String;
+ Public
+ Procedure Assign(aSource : TPersistent); override;
+ Function ToString : String; override;
+ Property ElementID : UTF8String Read FElementID Write FElementID;
+ Property TagName : UTF8String Read FTagName Write FTagName;
+ Property InputType : UTF8String Read FInputType Write FInputType;
+ Property InputName : UTF8String Read FInputName Write FInputName;
+ end;
+
+ { TTagInfoList }
+
+ TTagInfoList = class(TCollection)
+ private
+ function GetTag(aIndex : Integer): TTagInfoItem;
+ procedure SetTag(aIndex : Integer; AValue: TTagInfoItem);
+ Public
+ function AddTagItem(const aElementID, aTag, aType, aName: String): TTagInfoItem;
+ Property Tags [aIndex : Integer] : TTagInfoItem Read GetTag Write SetTag; default;
+ end;
+
+
+ TExtractOptions = set of TExtractOption;
THTMLExtractIDS = Class(TComponent)
Private
FBelowID: String;
FLevel: Integer;
- FList: TStrings;
+ FList: TTagInfoList;
+ FOptions: TExtractOptions;
Protected
procedure DoStartElement(Sender: TObject; const {%H-}NamespaceURI, {%H-}LocalName,
{%H-}QName: SAXString; Atts: TSAXAttributes); virtual;
procedure DoEndElement(Sender: TObject; const {%H-}NamespaceURI, {%H-}LocalName,
{%H-}QName: SAXString); virtual;
- Property List : TStrings Read FList;
+ Property List : TTagInfoList Read FList;
Property Level : Integer Read FLevel Write FLevel;
Public
- Procedure ExtractIDS(aInput : TStream; aList : TStrings);
- Function ExtractIDS(aInput : TStream) : TStringArray;
- Procedure ExtractIDS(Const aFileName : String; aList : TStrings);
- function ExtractIDS(const aFileName: String): TStringArray;
+ Procedure ExtractIDS(aInput : TStream; aList : TTagInfoList); overload;
+ Procedure ExtractIDS(aInput : TStream; aList : TStrings); overload;
+ Function ExtractIDS(aInput : TStream) : TStringArray; overload;
+ Procedure ExtractIDS(Const aFileName : String; aList : TTagInfoList); overload;
+ Procedure ExtractIDS(Const aFileName : String; aList : TStrings); overload;
+ function ExtractIDS(const aFileName: String): TStringArray; overload;
Property BelowID : String Read FBelowID Write FBelowID;
+ Property Options : TExtractOptions Read FOptions Write FOptions;
end;
{ TFormCodeGen }
@@ -338,13 +390,95 @@ implementation
uses TypInfo, bufstream;
+{ TTagInfoList }
+
+function TTagInfoList.GetTag(aIndex : Integer): TTagInfoItem;
+begin
+ Result:=Items[aIndex] as TTagInfoItem;
+end;
+
+procedure TTagInfoList.SetTag(aIndex : Integer; AValue: TTagInfoItem);
+begin
+ Items[aIndex]:=aValue;
+end;
+
+function TTagInfoList.AddTagItem(const aElementID, aTag, aType, aName: String
+ ): TTagInfoItem;
+begin
+ Result:=TTagInfoItem(Add);
+ Result.ElementID:=aElementID;
+ Result.TagName:=aTag;
+ Result.InputType:=aType;
+ Result.InputName:=aName;
+end;
+
+{ TTagInfoItem }
+
+procedure TTagInfoItem.Assign(aSource: TPersistent);
+
+Var
+ Src : TTagInfoItem absolute aSource;
+
+begin
+ if aSource is TTagInfoItem then
+ begin
+ ElementID:=Src.ElementID;
+ InputName:=Src.InputName;
+ InputType:=Src.InputType;
+ TagName:=Src.TagName;
+ end
+ else
+ inherited Assign(aSource);
+end;
+
+function TTagInfoItem.ToString: String;
+begin
+ Result:=ElementID;
+ if (TagName<>'') or (InputType<>'') or (InputName<>'') then
+ Result:=Result+'=';
+ Result:=Result+TagName;
+ if InputType<>'' then
+ Result:=Result+'['+InputType+']';
+ if InputName<>'' then
+ Result:=Result+'('+InputName+')';
+end;
+
+{ TTagInfo }
+
+constructor TTagInfo.Create(const aTag, aType, aName: String);
+begin
+ FTag:=aTag;
+ FInputType:=aType;
+ FInputName:=aName;
+end;
+
+function TTagInfo.ToString: String;
+begin
+ Result:=FTag;
+ if FInputType<>'' then
+ Result:=Result+'['+FInputType+']'
+end;
+
{ THTMLExtractIDS }
procedure THTMLExtractIDS.DoStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString; Atts: TSAXAttributes);
+ function GetIndex(const aName: SAXString): Integer;
+
+ begin
+ Result := Atts.Length-1;
+ while (Result>=0) and not SameText(UTF8Encode(Atts.LocalNames[Result]),UTF8Encode(aName)) do
+ Dec(Result);
+ end;
+
Var
- aID: String;
+ aID,aTag,aType,aName: UTF8String;
+ Idx : Integer;
+
begin
+ aTag:='';
+ aType:='';
+ aName:='';
if Not Assigned(atts) then exit;
aID:=UTF8Encode(Atts.GetValue('','id'));
if (aID<>'') then
@@ -356,7 +490,19 @@ begin
end
else if (BelowID<>'') and (Level<=0) then
Exit;
- FList.Add(aID);
+ if eoExtraInfo in FOptions then
+ begin
+ aTag:=LowerCase(UTF8Encode(LocalName));
+ if SameText(aTag,'input') then
+ begin
+ idx:=GetIndex('type');
+ if Idx=-1 then
+ aType:='text'
+ else
+ aType:=LowerCase(Utf8Encode(Atts.LocalNames[Idx]));
+ end;
+ end;
+ FList.AddTagItem(aID,aTag,aType,aName);
end;
end;
@@ -367,6 +513,32 @@ begin
end;
procedure THTMLExtractIDS.ExtractIDS(aInput: TStream; aList: TStrings);
+
+Var
+ aCol : TTagInfoList;
+ aItm : TTagInfoItem;
+ obj : TTagInfo;
+ I : Integer;
+
+begin
+ Obj:=nil;
+ aCol:=TTagInfoList.Create(TTagInfoItem);
+ try
+ ExtractIDS(aInput,aCol);
+ For I:=0 to aCol.Count-1 do
+ begin
+ aItm:=aCol[i];
+ if eoExtraInfo in FOptions then
+ Obj:=TTagInfo.Create(aItm.TagName,aItm.InputType,aItm.InputName);
+ aList.AddObject(aItm.ElementID,Obj);
+ end;
+ finally
+ aCol.Free;
+ end;
+end;
+
+procedure THTMLExtractIDS.ExtractIDS(aInput: TStream; aList: TTagInfoList);
+
var
MyReader : THTMLReader;
@@ -380,28 +552,51 @@ begin
finally
FreeAndNil(MyReader);
end;
-
end;
function THTMLExtractIDS.ExtractIDS(aInput: TStream): TStringArray;
Var
L : TStringList;
+ S : String;
I : Integer;
begin
L:=TStringList.Create;
try
+ L.OwnsObjects:=True;
ExtractIDS(aInput,L);
L.Sort;
Setlength(Result{%H-},L.Count);
For I:=0 to L.Count-1 do
- Result[I]:=L[i];
+ begin
+ S:=L[i];
+ if Assigned(L.Objects[i]) then
+ S:=S+TTagInfo(L.Objects[i]).ToString;
+ Result[I]:=S;
+ end;
finally
L.Free;
end;
end;
+procedure THTMLExtractIDS.ExtractIDS(const aFileName: String;
+ aList: TTagInfoList);
+Var
+ F : TFileStream;
+ B : TBufStream;
+
+begin
+ F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
+ try
+ B:=TReadBufStream.Create(F,4096);
+ B.SourceOwner:=True;
+ ExtractIDS(B,aList);
+ finally
+ B.Free;
+ end;
+end;
+
procedure THTMLExtractIDS.ExtractIDS(const aFileName: String; aList: TStrings);
Var
@@ -424,6 +619,7 @@ function THTMLExtractIDS.ExtractIDS(const aFileName : String): TStringArray;
Var
L : TStringList;
I : Integer;
+ S : String;
begin
L:=TStringList.Create;
@@ -432,7 +628,12 @@ begin
L.Sort;
Setlength(Result{%H-},L.Count);
For I:=0 to L.Count-1 do
- Result[I]:=L[i];
+ begin
+ S:=L[i];
+ if Assigned(L.Objects[i]) then
+ S:=S+TTagInfo(L.Objects[i]).ToString;
+ Result[I]:=S;
+ end;
finally
L.Free;
end;
diff --git a/components/pas2js/idehtmltools.pas b/components/pas2js/idehtmltools.pas
index f516316fa5..9f712feb74 100644
--- a/components/pas2js/idehtmltools.pas
+++ b/components/pas2js/idehtmltools.pas
@@ -5,7 +5,7 @@ unit idehtmltools;
interface
uses
- Classes, SysUtils, contnrs, ProjectIntf;
+ Classes, SysUtils, contnrs, idehtml2class, ProjectIntf;
Const
// Options for HTML -> class generation
@@ -16,11 +16,11 @@ Const
Type
{ TIDEHTMLTools }
+ TComponentHTMLFileNameHandler = procedure (Sender : TObject; aComponent : TComponent; var aHTMLFileName : string) of object;
TIDEHTMLTools = class(TPersistent)
Private
Type
-
{ TTagCacheItem }
TTagCacheItem = class
@@ -30,21 +30,44 @@ Type
Constructor Create(Const aFilename : String; aTimeStamp : TDateTime; aTags: TStringArray);
function IsValid : Boolean;
end;
- function HasCached(const aFileName: string; aList: TStrings): Boolean;
+
+ { THandler }
+
+ THandler = Class(TObject)
+ Private
+ FClass : TComponentClass;
+ FHandler : TComponentHTMLFileNameHandler;
+ Public
+ Constructor Create(aClass : TComponentClass; aHandler: TComponentHTMLFileNameHandler);
+ Function Matches(aClass : TComponentClass; aHandler: TComponentHTMLFileNameHandler) : Boolean;
+ Function MatchesClass(aClass : TComponentClass) : Boolean;
+ Property ComponentClass : TComponentClass Read FClass;
+ Property Handler : TComponentHTMLFileNameHandler Read FHandler;
+ end;
+
+ function GetNameFromComponent(aComponent: TComponent): string;
+ Private
+ Class Var
+ _ComponentHandlers : TFPObjectList;
Private
FTagCache : TFPObjectHashTable;
+ function HasCached(const aFileName: string; aList: TStrings): Boolean;
Public
class function GetDefaultHTMLDesignFile(aFile: TLazProjectFile): String;
class function GetDefaultHTML2ClassFile(aFile: TLazProjectFile): String;
- class function GetProjectHTMLFile : String;
Public
Constructor Create;
- Procedure GetTagIDs(Const aFileName : string; aList : TStrings);
- Function GetTagIDs(Const aFileName : string) : TStringArray;
+ Class Constructor Init;
+ Class Destructor Done;
+ Class Procedure RegisterComponent2HTMLFileHandler(aClass : TComponentClass; aHandler : TComponentHTMLFileNameHandler);
+ Class Procedure UnRegisterComponent2HTMLFileHandler(aClass : TComponentClass; aHandler : TComponentHTMLFileNameHandler);
+ Procedure GetTagIDs(Const aFileName : string; aList : TStrings; aOptions : TExtractOptions = []);
+ Procedure GetTagIDs(Const aFileName : string; aList : TTagInfoList; aOptions : TExtractOptions = []);
+ Function GetTagIDs(Const aFileName : string; aOptions : TExtractOptions = []) : TStringArray;
class function TagToIdentifier(aTag: String): String;
function GetHTMLFileForProjectFile(aFile: TLazProjectFile): String;
Function GetHTMLFileForComponent(aComponent : TComponent) : String;
-
+ class function GetProjectHTMLFile : String;
Procedure ClearCache;
end;
@@ -53,7 +76,27 @@ Var
implementation
-uses LazIDEIntf, forms, idehtml2class, pjscontroller;
+uses LazIDEIntf, forms, pjscontroller;
+
+{ TIDEHTMLTools.THandler }
+
+constructor TIDEHTMLTools.THandler.Create(aClass: TComponentClass;
+ aHandler: TComponentHTMLFileNameHandler);
+begin
+ FClass:=aClass;
+ FHandler:=aHandler;
+end;
+
+function TIDEHTMLTools.THandler.Matches(aClass: TComponentClass;
+ aHandler: TComponentHTMLFileNameHandler): Boolean;
+begin
+ Result:=(aHandler=FHandler) and MatchesClass(aClass);
+end;
+
+function TIDEHTMLTools.THandler.MatchesClass(aClass: TComponentClass): Boolean;
+begin
+ Result:=aClass.InheritsFrom(FClass);
+end;
{ TIDEHTMLTools.TTagCacheItem }
@@ -82,7 +125,37 @@ begin
end;
-Class Function TIDEHTMLTools.TagToIdentifier(aTag : String) : String;
+class constructor TIDEHTMLTools.Init;
+begin
+ _ComponentHandlers:=TFPObjectList.Create(True);
+end;
+
+class destructor TIDEHTMLTools.Done;
+begin
+ FreeAndNil(_ComponentHandlers);
+end;
+
+class procedure TIDEHTMLTools.RegisterComponent2HTMLFileHandler(
+ aClass: TComponentClass; aHandler: TComponentHTMLFileNameHandler);
+begin
+ _ComponentHandlers.Add(THandler.Create(aClass,aHandler));
+end;
+
+class procedure TIDEHTMLTools.UnRegisterComponent2HTMLFileHandler(
+ aClass: TComponentClass; aHandler: TComponentHTMLFileNameHandler);
+
+Var
+ Idx : Integer;
+
+begin
+ Idx:=_ComponentHandlers.Count-1;
+ While (Idx>=0) and not THandler(_ComponentHandlers[Idx]).Matches(aClass,aHandler) do
+ Dec(Idx);
+ if Idx>=0 then
+ _ComponentHandlers.Delete(Idx);
+end;
+
+class function TIDEHTMLTools.TagToIdentifier(aTag: String): String;
Var
C : Char;
@@ -116,7 +189,7 @@ begin
end;
-procedure TIDEHTMLTools.GetTagIDs(const aFileName: string; aList: TStrings);
+procedure TIDEHTMLTools.GetTagIDs(const aFileName: string; aList: TStrings; aOptions : TExtractOptions = []);
Var
Itm : TTagCacheItem;
@@ -125,6 +198,7 @@ begin
If Not HasCached(aFileName,aList) then
with THTMLExtractIDS.Create(Nil) do
try
+ Options:=aOptions;
ExtractIDS(aFileName,aList);
Itm:=TTagCacheItem.Create(aFileName,Now,aList.ToStringArray);
FTagCache.Add(aFileName,Itm);
@@ -133,7 +207,20 @@ begin
end;
end;
-function TIDEHTMLTools.GetTagIDs(const aFileName: string): TStringArray;
+procedure TIDEHTMLTools.GetTagIDs(const aFileName: string; aList: TTagInfoList;
+ aOptions: TExtractOptions);
+begin
+ // Todo : cache
+ with THTMLExtractIDS.Create(Nil) do
+ try
+ Options:=aOptions;
+ ExtractIDS(aFileName,aList);
+ finally
+ Free;
+ end;
+end;
+
+function TIDEHTMLTools.GetTagIDs(const aFileName: string; aOptions : TExtractOptions = []): TStringArray;
Var
aList : TStrings;
@@ -141,7 +228,7 @@ Var
begin
aList:=TStringList.Create;
try
- GetTagIDS(aFileName,aList);
+ GetTagIDS(aFileName,aList,aOptions);
Result:=aList.ToStringArray;
finally
aList.Free;
@@ -152,7 +239,8 @@ class function TIDEHTMLTools.GetDefaultHTMLDesignFile(aFile: TLazProjectFile
): String;
begin
- Result:=aFile.CustomData.Values[SDesignHTMLFile];
+ if assigned(aFile) and assigned(aFile.CustomData) then
+ Result:=aFile.CustomData.Values[SDesignHTMLFile];
end;
class function TIDEHTMLTools.GetDefaultHTML2ClassFile(aFile : TLazProjectFile) : String;
@@ -199,7 +287,7 @@ begin
end;
if Result='' then
begin
- Result:=Prj.CustomData.Values[PJSProjectHTMLFile];
+ Result:=TPJSController.GetProjectHTMLFilename(Prj);
if not FileExists(Result) then
Result:='';
end;
@@ -217,13 +305,41 @@ begin
Result:=GetProjectHTMLFile;
end;
+function TIDEHTMLTools.GetNameFromComponent(aComponent : TComponent) : string;
+
+Var
+ Idx,aCount : Integer;
+ aClass : TComponentClass;
+
+begin
+ Result:='';
+ aCount:=_ComponentHandlers.Count;
+ aClass:=TComponentClass(aComponent.ClassType);
+ Idx:=0;
+ While (Result='') and (Idx'' then
- begin
- if Load then
- aProject.ConvertFromLPIFilename(fn)
- else
- aProject.ConvertToLPIFilename(fn);
- CustomData[PJSProjectHTMLFile]:=fn;
- end;
- end;
- end;
- if PathDelimChanged then ;
-end;
function TPJSController.OnProjectBuilding(Sender: TObject): TModalResult;
var
@@ -198,12 +177,32 @@ begin
Result:=RunProject(Sender,false,Handled);
end;
-function TPJSController.GetHTMLFilename(aProject: TLazProject;
- UseTestDir: boolean): string;
+class function TPJSController.GetProjectHTMLFilename(aProject: TLazProject): string;
+
+Var
+ I : Integer;
+
+begin
+ Result:=aProject.CustomData.Values[PJSProjectHTMLFile{%H-}];
+ If Result='' then
+ begin
+ I:=aProject.FileCount-1;
+ While (Result='') and (I>=0) do
+ begin
+ if aProject.Files[I].CustomData[PJSIsProjectHTMLFile]='1' then
+ Result:=aProject.Files[I].GetFullFilename;
+ Dec(I);
+ end;
+ end;
+end;
+
+function TPJSController.GetHTMLFilename(aProject: TLazProject; UseTestDir: boolean): string;
+
var
HTMLFile: TLazProjectFile;
+
begin
- Result:=aProject.CustomData.Values[PJSProjectHTMLFile];
+ Result:=GetProjectHTMLFileName(aProject);
if Result='' then exit;
if aProject.IsVirtual then
begin
@@ -372,7 +371,7 @@ var
begin
// if project has a pas2js html filename, save it to the test directory
Result:=false;
- HTMLFilename:=aProject.CustomData.Values[PJSProjectHTMLFile];
+ HTMLFilename:=GetProjectHTMLFilename(aProject);
if (HTMLFilename='') then
exit(true);
if FilenameIsAbsolute(HTMLFilename) then
@@ -383,7 +382,7 @@ begin
HTMLFile:=aProject.FindFile(HTMLFilename,[pfsfOnlyProjectFiles]);
if HTMLFile=nil then
begin
- debugln(['Warning: TPJSController.SaveHTMLFileToTestDir invalid aProject.CustomData.Values[',PJSProjectHTMLFile,']']);
+ debugln(['Warning: TPJSController.SaveHTMLFileToTestDir invalid project filename [',HTMLFilename,']']);
exit;
end;
HTMLFilename:=HTMLFile.Filename;
@@ -429,7 +428,6 @@ begin
LazarusIDE.AddHandlerOnProjectBuilding(@OnProjectBuilding);
LazarusIDE.AddHandlerOnRunDebugInit(@OnRunDebugInit);
LazarusIDE.AddHandlerOnRunWithoutDebugInit(@OnRunWithoutDebugInit);
- LazarusIDE.AddHandlerOnLoadSaveCustomData(@OnLoadSaveCustomData);
ProjectGroupManager.AddHandlerOnRunLazbuild(@OnProjectGroupRunLazbuild);
end;
diff --git a/components/pas2js/pjsdsgnregister.pas b/components/pas2js/pjsdsgnregister.pas
index 0063cbd3bd..659940582f 100644
--- a/components/pas2js/pjsdsgnregister.pas
+++ b/components/pas2js/pjsdsgnregister.pas
@@ -1651,7 +1651,6 @@ Var
begin
HTMLFile:=AProject.CreateProjectFile(HTMLFilename);
HTMLFile.IsPartOfProject:=true;
- AProject.CustomData.Values[PJSProjectHTMLFile]:=HTMLFile.Filename;
AProject.AddFile(HTMLFile,false);
ScriptType:='';
if baoUseModule in Options then
diff --git a/components/pas2js/pjsprojectoptions.pp b/components/pas2js/pjsprojectoptions.pp
index 4fad455a78..61a312ce24 100644
--- a/components/pas2js/pjsprojectoptions.pp
+++ b/components/pas2js/pjsprojectoptions.pp
@@ -311,7 +311,7 @@ begin
CBWebProject.Checked:=Prj.CustomData[PJSProjectWebBrowser]='1';
if HTMLIdx=-1 then
begin
- HFN:=Prj.CustomData[PJSProjectHTMLFile];
+ HFN:=TPJSController.GetProjectHTMLFilename(Prj);
HTMLIdx:=CBHTMLFile.Items.IndexOf(HFN);
end;
CBHTMLFile.ItemIndex:=HTMLIdx;
@@ -353,7 +353,6 @@ begin
begin
Remove(PJSProject);
Remove(PJSProjectWebBrowser);
- Remove(PJSProjectHTMLFile);
Remove(PJSProjectMaintainHTML);
Remove(PJSProjectUseBrowserConsole);
Remove(PJSProjectRunAtReady);