mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-06 05:38:25 +02:00
* Fixed determining the HTML file of the project
This commit is contained in:
Michaël Van Canneyt
parent
f54488e9b9
commit
cd0630d395
@ -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;
|
||||
|
||||
@ -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<aCount) do
|
||||
With THandler(_ComponentHandlers[Idx]) do
|
||||
begin
|
||||
// Writeln('Checking class ',aClass);
|
||||
if MatchesClass(aClass) then
|
||||
Handler(Self,aComponent,Result);
|
||||
Inc(Idx);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TIDEHTMLTools.GetHTMLFileForComponent(aComponent: TComponent): String;
|
||||
|
||||
Var
|
||||
aFile : TLazProjectFile;
|
||||
begin
|
||||
aFile:=LazarusIDE.GetProjectFileWithRootComponent(aComponent.Owner);
|
||||
Result:=GetHTMLFileForProjectFile(aFile);
|
||||
Result:=GetNameFromComponent(aComponent);
|
||||
if Result='' then
|
||||
begin
|
||||
aFile:=LazarusIDE.GetProjectFileWithRootComponent(aComponent.Owner);
|
||||
if aFile=Nil then
|
||||
aFile:=LazarusIDE.GetProjectFileWithRootComponent(aComponent);
|
||||
if Assigned(aFile) then
|
||||
Result:=GetHTMLFileForProjectFile(aFile);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TIDEHTMLTools.ClearCache;
|
||||
|
||||
@ -28,8 +28,6 @@ Type
|
||||
function GetPas2JSBrowser(const s: string; const {%H-}Data: PtrInt; var Abort: boolean): string;
|
||||
function GetPas2JSNodeJS(const s: string; const {%H-}Data: PtrInt; var Abort: boolean): string;
|
||||
function GetPas2jsProjectURL(const s: string; const {%H-}Data: PtrInt; var Abort: boolean): string;
|
||||
procedure OnLoadSaveCustomData(Sender: TObject; Load: boolean;
|
||||
CustomData: TStringToStringTree; PathDelimChanged: boolean);
|
||||
function OnProjectBuilding(Sender: TObject): TModalResult;
|
||||
function OnProjectGroupRunLazbuild({%H-}Target: TPGCompileTarget;
|
||||
Tool: TAbstractExternalTool): boolean;
|
||||
@ -45,8 +43,13 @@ Type
|
||||
Class Function instance : TPJSController;
|
||||
Procedure Hook; virtual;
|
||||
Procedure UnHook; virtual;
|
||||
// Determine project HTML file from custom data
|
||||
class function GetProjectHTMLFilename(aProject: TLazProject): string;
|
||||
// Get filename to show in browser when running
|
||||
function GetHTMLFilename(aProject: TLazProject; UseTestDir: boolean): string; virtual;
|
||||
// Return directory for webserver
|
||||
function GetWebDir(aProject: TLazProject): string; virtual;
|
||||
// Get project URL.
|
||||
function GetProjectURL(aProject: TLazProject): string; virtual;
|
||||
Property OnRefresh : TNotifyEvent Read FOnRefresh Write FonRefresh;
|
||||
end;
|
||||
@ -55,14 +58,14 @@ Const
|
||||
// Custom settings in .lpi
|
||||
PJSProject = 'Pas2JSProject'; // Project is pas2js project
|
||||
PJSProjectWebBrowser = 'PasJSWebBrowserProject'; // Web browser project
|
||||
PJSProjectHTMLFile = 'PasJSHTMLFile';
|
||||
PJSProjectHTMLFile = 'PasJSHTMLFile' deprecated 'use TPJSController.GetProjectHTMLFilename'; // No longer used
|
||||
PJSIsProjectHTMLFile = 'PasJSIsProjectHTMLFile';
|
||||
PJSProjectMaintainHTML = 'MaintainHTML';
|
||||
PJSProjectUseBrowserConsole = 'BrowserConsole';
|
||||
PJSProjectRunAtReady = 'RunAtReady';
|
||||
PJSProjectPort = 'PasJSPort';
|
||||
PJSProjectURL = 'PasJSURL';
|
||||
|
||||
PJSProjectHTMLBaseDir = 'HTMLDir';
|
||||
|
||||
implementation
|
||||
|
||||
@ -137,30 +140,6 @@ begin
|
||||
DebugLN(['Hint: (lazarus) [TPJSController.GetPas2jsProjectURL] Result="',Result,'"']);
|
||||
end;
|
||||
|
||||
procedure TPJSController.OnLoadSaveCustomData(Sender: TObject; Load: boolean;
|
||||
CustomData: TStringToStringTree; PathDelimChanged: boolean);
|
||||
var
|
||||
fn: String;
|
||||
aProject: TLazProject;
|
||||
begin
|
||||
if Sender is TLazProject then
|
||||
begin
|
||||
aProject:=TLazProject(Sender);
|
||||
if CustomData[PJSProjectWebBrowser]='1' then
|
||||
begin
|
||||
fn:=CustomData[PJSProjectHTMLFile];
|
||||
if fn<>'' 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;
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user