From cd0630d395f60fc1f703078b179412b263b234ee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C3=ABl=20Van=20Canneyt?= Date: Mon, 18 Apr 2022 13:12:05 +0200 Subject: [PATCH] * Fixed determining the HTML file of the project --- components/pas2js/idehtml2class.pas | 223 +++++++++++++++++++++++-- components/pas2js/idehtmltools.pas | 148 ++++++++++++++-- components/pas2js/pjscontroller.pp | 66 ++++---- components/pas2js/pjsdsgnregister.pas | 1 - components/pas2js/pjsprojectoptions.pp | 3 +- 5 files changed, 377 insertions(+), 64 deletions(-) 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);