mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 14:38:01 +02:00
IDE: javascript: started example to read xml with javascript identifiers
git-svn-id: trunk@23698 -
This commit is contained in:
parent
b87f87e8af
commit
6d31c5de0b
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -587,6 +587,10 @@ components/compilers/c/lazc.lpk svneol=native#text/plain
|
||||
components/compilers/c/lazc.pas svneol=native#text/plain
|
||||
components/compilers/c/lazcstrconsts.pas svneol=native#text/plain
|
||||
components/compilers/c/lazcutil.pas svneol=native#text/plain
|
||||
components/compilers/javascript/examples/ReadJSClassesXML.ico -text svneol=unset#image/ico
|
||||
components/compilers/javascript/examples/ReadJSClassesXML.lpi svneol=native#text/plain
|
||||
components/compilers/javascript/examples/ReadJSClassesXML.lpr svneol=native#text/plain
|
||||
components/compilers/javascript/examples/jsclassxmlread.pas svneol=native#text/plain
|
||||
components/custom/README.txt svneol=native#text/plain
|
||||
components/customform/custforms.pp svneol=native#text/plain
|
||||
components/customform/demo/appform.pas svneol=native#text/plain
|
||||
|
BIN
components/compilers/javascript/examples/ReadJSClassesXML.ico
Normal file
BIN
components/compilers/javascript/examples/ReadJSClassesXML.ico
Normal file
Binary file not shown.
After Width: | Height: | Size: 134 KiB |
@ -0,0 +1,81 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="7"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<UseDefaultCompilerOptions Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InIDEConfig"/>
|
||||
<MainUnit Value="0"/>
|
||||
<TargetFileExt Value=""/>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<ProjectVersion Value=""/>
|
||||
<Language Value=""/>
|
||||
<CharSet Value=""/>
|
||||
</VersionInfo>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IgnoreBinaries Value="False"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="CodeTools"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="ReadJSClassesXML.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ReadJSClassesXML"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="jsclassxmlread.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="JSClassXMLRead"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="8"/>
|
||||
<Target>
|
||||
<Filename Value="ReadJSClassesXML"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)/"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<UseAnsiStrings Value="True"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
@ -0,0 +1,28 @@
|
||||
{ Author: Mattias Gaertner
|
||||
Reading a xml file with javascript identifiers
|
||||
|
||||
bugs in extjs3.xml:
|
||||
method name: jsname="NativeWindow.getRootHtmlWindow"
|
||||
jsname="an element"
|
||||
jsname="mst have a center region"
|
||||
jsname="Introspector.extend"
|
||||
jsname="MultiCombo.Checkable"
|
||||
|
||||
}
|
||||
program ReadJSClassesXML;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Classes, sysutils, JSClassXMLRead;
|
||||
|
||||
var
|
||||
t: TJavascriptIdentifierTree;
|
||||
Filename: String;
|
||||
begin
|
||||
t:=TJavascriptIdentifierTree.Create;
|
||||
Filename:=ExpandFileName(ParamStr(1));
|
||||
t.LoadFromFile(Filename);
|
||||
t.Free;
|
||||
end.
|
||||
|
675
components/compilers/javascript/examples/jsclassxmlread.pas
Normal file
675
components/compilers/javascript/examples/jsclassxmlread.pas
Normal file
@ -0,0 +1,675 @@
|
||||
unit JSClassXMLRead;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileProcs, OtherIdentifierTree, XMLRead, XMLCfg, DOM,
|
||||
avl_tree;
|
||||
|
||||
type
|
||||
TJSIdentifier = class(TOtherIdentifierTreeNode)
|
||||
public
|
||||
JSName: string;
|
||||
PascalName: string;
|
||||
end;
|
||||
|
||||
TJSIUnresolvedIdentifier = class(TJSIdentifier)
|
||||
public
|
||||
Resolved: TJSIdentifier;
|
||||
end;
|
||||
|
||||
TJSIAlias = class(TJSIdentifier)
|
||||
public
|
||||
PointsTo: TJSIdentifier;
|
||||
end;
|
||||
|
||||
TJSIClass = class;
|
||||
|
||||
TJSIParameter = class(TJSIdentifier)
|
||||
public
|
||||
Typ: TJSIdentifier;
|
||||
Optional: boolean;
|
||||
end;
|
||||
|
||||
TJSIMethodFlag = (
|
||||
jsimStatic,
|
||||
jsimOverload
|
||||
);
|
||||
TJSIMethodFlags = set of TJSIMethodFlag;
|
||||
|
||||
{ TJSIMethod }
|
||||
|
||||
TJSIMethod = class(TJSIdentifier)
|
||||
public
|
||||
Flags: TJSIMethodFlags;
|
||||
JSIClass: TJSIClass;
|
||||
Params: TFPList; // list of TJSIParameter
|
||||
ReturnType: TJSIdentifier;
|
||||
destructor Destroy; override;
|
||||
procedure ClearParams;
|
||||
procedure AddParameter(aParam: TJSIParameter);
|
||||
end;
|
||||
|
||||
TJSIPropertyFlag = (
|
||||
jsipEnum,
|
||||
jsipConfig,
|
||||
jsipStatic,
|
||||
jsipDefault
|
||||
);
|
||||
TJSIPropertyFlags = set of TJSIPropertyFlag;
|
||||
|
||||
TJSIProperty = class(TJSIdentifier)
|
||||
public
|
||||
Flags: TJSIPropertyFlags;
|
||||
Typ: TJSIdentifier;
|
||||
end;
|
||||
|
||||
TJSIClassFlag = (
|
||||
jsicAutoCreated
|
||||
);
|
||||
TJSIClassFlags = set of TJSIClassFlag;
|
||||
|
||||
{ TJSIClass }
|
||||
|
||||
TJSIClass = class(TJSIdentifier)
|
||||
public
|
||||
Flags: TJSIClassFlags;
|
||||
ParentClass: TJSIdentifier;
|
||||
Unitname: TJSIdentifier;
|
||||
Simplename: TJSIdentifier;
|
||||
Methods: TFPList; // list of TJSIMethod
|
||||
Properties: TFPList; // list TJSIProperty
|
||||
Classes: TFPList; // list of TJSIClass
|
||||
destructor Destroy; override;
|
||||
procedure ClearMethods;
|
||||
procedure ClearProperties;
|
||||
procedure ClearClasses;
|
||||
function FindIdentifier(const AJSName: string): TJSIdentifier;
|
||||
procedure AddClass(AClass: TJSIClass);
|
||||
procedure AddMethod(AMethod: TJSIMethod);
|
||||
procedure AddProperty(AProperty: TJSIProperty);
|
||||
end;
|
||||
|
||||
{ TJavascriptIdentifierTree }
|
||||
|
||||
TJavascriptIdentifierTree = class(TOtherIdentifierTree)
|
||||
private
|
||||
function FindNode(Doc: TXMLDocument; const APath: String; PathHasValue: boolean): TDomNode;
|
||||
function Escape(const s: String): String;
|
||||
procedure ReadExtJSNodes(Node: TDOMNode);
|
||||
procedure ReadExtJSUnits(UnitsNode: TDOMNode);
|
||||
procedure ReadExtJSClasses(ClassesNode: TDOMNode);
|
||||
procedure ReadExtJSMethods(ClassNode: TDOMNode; JSIClass: TJSIClass);
|
||||
procedure ReadExtJSProperties(ClassNode: TDOMNode; JSIClass: TJSIClass);
|
||||
function CreateClass(const Path: string; CreateLast: boolean): TJSIClass;
|
||||
function CreateAlias(const Path: string): TJSIAlias;
|
||||
function FindGlobal(const aJSName: string): TAVLTreeNode;
|
||||
function CreateUnresolved(const aPath: string): TJSIUnresolvedIdentifier;
|
||||
public
|
||||
Globals: TAVLTree;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure LoadFromFile(Filename: string);
|
||||
procedure ClearGlobals;
|
||||
end;
|
||||
|
||||
function CompareJSIdentifiers(Data1, Data2: Pointer): integer;
|
||||
function CompareJSNameWithJSIdentifier(Key, Data: Pointer): integer;
|
||||
function IsValidJSName(const Name: string): boolean;
|
||||
|
||||
implementation
|
||||
|
||||
function CompareJSIdentifiers(Data1, Data2: Pointer): integer;
|
||||
var
|
||||
Ident1: TJSIdentifier absolute Data1;
|
||||
Ident2: TJSIdentifier absolute Data2;
|
||||
begin
|
||||
Result:=CompareStr(Ident1.JSName,Ident2.JSName);
|
||||
end;
|
||||
|
||||
function CompareJSNameWithJSIdentifier(Key, Data: Pointer): integer;
|
||||
var
|
||||
Ident: TJSIdentifier absolute Data;
|
||||
s: String;
|
||||
begin
|
||||
s:=AnsiString(Key);
|
||||
Result:=CompareStr(s,Ident.JSName);
|
||||
end;
|
||||
|
||||
function IsValidJSName(const Name: string): boolean;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result:=false;
|
||||
if Name='' then exit;
|
||||
if length(Name)>255 then exit;
|
||||
if not (Name[1] in ['a'..'z','A'..'Z','_']) then exit;
|
||||
for i:=1 to Length(Name) do
|
||||
if not (Name[i] in ['a'..'z','A'..'Z','_','0'..'9']) then exit;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
{ TJavascriptIdentifierTree }
|
||||
|
||||
function TJavascriptIdentifierTree.FindNode(Doc: TXMLDocument;
|
||||
const APath: String; PathHasValue: boolean): TDomNode;
|
||||
var
|
||||
NodePath: String;
|
||||
StartPos, EndPos: integer;
|
||||
PathLen: integer;
|
||||
begin
|
||||
Result := Doc.DocumentElement;
|
||||
debugln(['TJavascriptIdentifierTree.FindNode ',Result.NodeName]);
|
||||
PathLen := Length(APath);
|
||||
StartPos := 1;
|
||||
while Assigned(Result) do
|
||||
begin
|
||||
EndPos := StartPos;
|
||||
while (EndPos <= PathLen) and (APath[EndPos] <> '/') do
|
||||
Inc(EndPos);
|
||||
if (EndPos > PathLen) and PathHasValue then
|
||||
exit;
|
||||
if EndPos = StartPos then
|
||||
break;
|
||||
SetLength(NodePath, EndPos - StartPos);
|
||||
Move(APath[StartPos], NodePath[1], Length(NodePath));
|
||||
NodePath:=Escape(NodePath);
|
||||
debugln(['TJavascriptIdentifierTree.FindNode ',NodePath]);
|
||||
Result := Result.FindNode(NodePath);
|
||||
StartPos := EndPos + 1;
|
||||
if StartPos > PathLen then
|
||||
exit;
|
||||
end;
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TJavascriptIdentifierTree.Escape(const s: String): String;
|
||||
const
|
||||
AllowedChars = ['A'..'Z', 'a'..'z', '0'..'9', '.', '-', '_'];
|
||||
var
|
||||
EscapingNecessary: Boolean;
|
||||
i: Integer;
|
||||
begin
|
||||
if Length(s) < 1 then
|
||||
raise EXMLConfigError.Create(SMissingPathName);
|
||||
|
||||
if not (s[1] in ['A'..'Z', 'a'..'z', '_']) then
|
||||
EscapingNecessary := True
|
||||
else
|
||||
begin
|
||||
EscapingNecessary := False;
|
||||
for i := 2 to Length(s) do
|
||||
if not (s[i] in AllowedChars) then
|
||||
begin
|
||||
EscapingNecessary := True;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
if EscapingNecessary then
|
||||
begin
|
||||
Result := '_';
|
||||
for i := 1 to Length(s) do
|
||||
if s[i] in (AllowedChars - ['_']) then
|
||||
Result := Result + s[i]
|
||||
else
|
||||
Result := Result + '_' + IntToHex(Ord(s[i]), 2);
|
||||
end
|
||||
else // No escaping necessary
|
||||
Result := s;
|
||||
end;
|
||||
|
||||
procedure TJavascriptIdentifierTree.ReadExtJSNodes(Node: TDOMNode);
|
||||
var
|
||||
UnitsNode: TDOMNode;
|
||||
ClassesNode: TDOMNode;
|
||||
begin
|
||||
debugln(['TJavascriptIdentifierTree.ReadExtJSClasses ',DbgSName(Node)]);
|
||||
|
||||
UnitsNode:=Node.FindNode('units');
|
||||
if UnitsNode=nil then begin
|
||||
debugln(['TJavascriptIdentifierTree.ReadExtJSClasses no units found']);
|
||||
exit;
|
||||
end;
|
||||
ReadExtJSUnits(UnitsNode);
|
||||
|
||||
ClassesNode:=Node.FindNode('classes');
|
||||
if UnitsNode=nil then begin
|
||||
debugln(['TJavascriptIdentifierTree.ReadExtJSClasses no classes found']);
|
||||
exit;
|
||||
end;
|
||||
ReadExtJSClasses(ClassesNode);
|
||||
end;
|
||||
|
||||
procedure TJavascriptIdentifierTree.ReadExtJSUnits(UnitsNode: TDOMNode);
|
||||
var
|
||||
Node: TDOMNode;
|
||||
ClassesNode: TDOMNode;
|
||||
ClassNode: TDOMNode;
|
||||
CurUnitName, PascalClassname: widestring;
|
||||
begin
|
||||
Node:=UnitsNode.FirstChild;
|
||||
while Node<>nil do begin
|
||||
if (Node.NodeName='unit') and (Node is TDOMElement) then begin
|
||||
CurUnitName:=TDOMElement(Node).GetAttribute('name');
|
||||
ClassesNode:=Node.FindNode('classes');
|
||||
if (ClassesNode<>nil) and (CurUnitName<>'') then begin
|
||||
ClassNode:=ClassesNode.FirstChild;
|
||||
while ClassNode<>nil do begin
|
||||
if ClassNode.NodeName='class' then begin
|
||||
if ClassNode is TDOMElement then begin
|
||||
PascalClassname:=TDOMElement(ClassNode).GetAttribute('name');
|
||||
if PascalClassname<>'' then ;
|
||||
//debugln(['TJavascriptIdentifierTree.ReadExtJSUnits ',CurUnitName,' ',PascalClassname]);
|
||||
end;
|
||||
end;
|
||||
ClassNode:=ClassNode.NextSibling;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Node:=Node.NextSibling;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJavascriptIdentifierTree.ReadExtJSClasses(ClassesNode: TDOMNode);
|
||||
var
|
||||
Node: TDOMNode;
|
||||
ClassNode: TDOMElement;
|
||||
NewClass: TJSIClass;
|
||||
JSName: WideString;
|
||||
SimpleName: WideString;
|
||||
Alias: TJSIAlias;
|
||||
begin
|
||||
Node:=ClassesNode.FirstChild;
|
||||
while Node<>nil do begin
|
||||
if (Node.NodeName='class') and (Node is TDOMElement) then begin
|
||||
ClassNode:=TDOMElement(Node);
|
||||
JSName:=ClassNode.GetAttribute('jsname');
|
||||
if JSName<>'' then begin
|
||||
if JSName='Object' then begin
|
||||
debugln(['TJavascriptIdentifierTree.ReadExtJSClasses SKIPPING jsname=Object pasname=',ClassNode.GetAttribute('name')]);
|
||||
end else begin
|
||||
debugln(['TJavascriptIdentifierTree.ReadExtJSClasses class=',JSName]);
|
||||
// create new class
|
||||
NewClass:=CreateClass(JSName,true);
|
||||
if not (jsicAutoCreated in NewClass.Flags) then
|
||||
raise Exception.Create('class redefined: '+JSName);
|
||||
Exclude(NewClass.Flags,jsicAutoCreated);
|
||||
// pascalname
|
||||
NewClass.PascalName:=ClassNode.GetAttribute('name');
|
||||
// simplename
|
||||
SimpleName:=ClassNode.GetAttribute('simplename');
|
||||
if (SimpleName<>'') and (SimpleName<>JSName) then begin
|
||||
Alias:=CreateAlias(SimpleName);
|
||||
if (Alias.PointsTo<>nil) and (Alias.PointsTo<>NewClass) then
|
||||
raise Exception.Create('class simplename redefined: '+JSName+' '+SimpleName);
|
||||
NewClass.Simplename:=Alias;
|
||||
end;
|
||||
// methods
|
||||
ReadExtJSMethods(ClassNode,NewClass);
|
||||
// properties
|
||||
ReadExtJSProperties(ClassNode,NewClass);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Node:=Node.NextSibling;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJavascriptIdentifierTree.ReadExtJSMethods(ClassNode: TDOMNode;
|
||||
JSIClass: TJSIClass);
|
||||
var
|
||||
MethodsNode: TDOMNode;
|
||||
Node: TDOMNode;
|
||||
MethodNode: TDOMElement;
|
||||
JSName: WideString;
|
||||
NewMethod: TJSIMethod;
|
||||
ParamsNode: TDOMNode;
|
||||
SubNode: TDOMNode;
|
||||
NewParam: TJSIParameter;
|
||||
ParamNode: TDOMElement;
|
||||
ParamJSName: WideString;
|
||||
ReturnType: Widestring;
|
||||
begin
|
||||
MethodsNode:=ClassNode.FindNode('methods');
|
||||
if MethodsNode=nil then exit;
|
||||
Node:=MethodsNode.FirstChild;
|
||||
while Node<>nil do begin
|
||||
if (Node.NodeName='method') and (Node is TDOMElement) then begin
|
||||
MethodNode:=TDOMElement(Node);
|
||||
JSName:=MethodNode.GetAttribute('jsname');
|
||||
if copy(JSName,1,length(JSIClass.JSName)+1)=JSIClass.JSName+'.' then
|
||||
JSName:=copy(JSName,length(JSIClass.JSName)+2,length(JSName));
|
||||
if not IsValidJSName(JSName) then
|
||||
raise Exception.Create('invalid method name '+JSName);
|
||||
NewMethod:=TJSIMethod.Create;
|
||||
NewMethod.JSName:=JSName;
|
||||
JSIClass.AddMethod(NewMethod);
|
||||
NewMethod.PascalName:=MethodNode.GetAttribute('name');
|
||||
if MethodNode.GetAttribute('static')='1' then
|
||||
Include(NewMethod.Flags,jsimStatic);
|
||||
if MethodNode.GetAttribute('overload')='1' then
|
||||
Include(NewMethod.Flags,jsimOverload);
|
||||
// return type
|
||||
ReturnType:=MethodNode.GetAttribute('return');
|
||||
if ReturnType<>'' then
|
||||
NewMethod.ReturnType:=CreateUnresolved(ReturnType);
|
||||
// parameters
|
||||
ParamsNode:=MethodNode.FindNode('params');
|
||||
if ParamsNode<>nil then begin
|
||||
SubNode:=ParamsNode.FirstChild;
|
||||
while SubNode<>nil do begin
|
||||
if (SubNode is TDOMElement) and (SubNode.NodeName='param') then begin
|
||||
ParamNode:=TDOMElement(SubNode);
|
||||
ParamJSName:=ParamNode.GetAttribute('name');
|
||||
if not IsValidJSName(ParamJSName) then
|
||||
raise Exception.Create('invalid param name '+ParamJSName);
|
||||
NewParam:=TJSIParameter.Create;
|
||||
NewParam.JSName:=ParamJSName;
|
||||
NewParam.PascalName:=ParamJSName;
|
||||
NewParam.Optional:=ParamNode.GetAttribute('optional')='1';
|
||||
NewParam.Typ:=CreateUnresolved(ParamNode.GetAttribute('type'));
|
||||
NewMethod.AddParameter(NewParam);
|
||||
end;
|
||||
SubNode:=SubNode.NextSibling;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Node:=Node.NextSibling;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJavascriptIdentifierTree.ReadExtJSProperties(ClassNode: TDOMNode;
|
||||
JSIClass: TJSIClass);
|
||||
var
|
||||
PropertiesNode: TDOMNode;
|
||||
PropertyNode: TDOMElement;
|
||||
PropertyJSName: WideString;
|
||||
NewProperty: TJSIProperty;
|
||||
Node: TDOMNode;
|
||||
TypeName: WideString;
|
||||
begin
|
||||
// properties
|
||||
PropertiesNode:=ClassNode.FindNode('properties');
|
||||
if PropertiesNode=nil then exit;
|
||||
Node:=PropertiesNode.FirstChild;
|
||||
while Node<>nil do begin
|
||||
if (Node is TDOMElement) and (Node.NodeName='property') then begin
|
||||
PropertyNode:=TDOMElement(Node);
|
||||
PropertyJSName:=PropertyNode.GetAttribute('jsname');
|
||||
if not IsValidJSName(PropertyJSName) then
|
||||
raise Exception.Create('invalid property name '+PropertyJSName);
|
||||
NewProperty:=TJSIProperty.Create;
|
||||
NewProperty.JSName:=PropertyJSName;
|
||||
NewProperty.PascalName:=PropertyNode.GetAttribute('name');
|
||||
if PropertyNode.GetAttribute('enum')='1' then
|
||||
Include(NewProperty.Flags,jsipEnum);
|
||||
if PropertyNode.GetAttribute('config')='1' then
|
||||
Include(NewProperty.Flags,jsipConfig);
|
||||
if PropertyNode.GetAttribute('static')='1' then
|
||||
Include(NewProperty.Flags,jsipStatic);
|
||||
if PropertyNode.GetAttribute('default')='1' then
|
||||
Include(NewProperty.Flags,jsipDefault);
|
||||
TypeName:=PropertyNode.GetAttribute('type');
|
||||
if (jsipEnum in NewProperty.Flags) and (TypeName[1]='(') then
|
||||
TypeName:='';
|
||||
if TypeName<>'' then
|
||||
NewProperty.Typ:=CreateUnresolved(TypeName);
|
||||
JSIClass.AddProperty(NewProperty);
|
||||
end;
|
||||
Node:=Node.NextSibling;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TJavascriptIdentifierTree.CreateClass(const Path: string; CreateLast: boolean
|
||||
): TJSIClass;
|
||||
var
|
||||
p: Integer;
|
||||
StartPos: Integer;
|
||||
AName: String;
|
||||
AVLNode: TAVLTreeNode;
|
||||
Identifier: TJSIdentifier;
|
||||
Parent: TJSIClass;
|
||||
IsLast: Boolean;
|
||||
PropType: TJSIdentifier;
|
||||
begin
|
||||
Result:=nil;
|
||||
p:=1;
|
||||
repeat
|
||||
StartPos:=p;
|
||||
while (p<=length(Path)) and (Path[p]<>'.') do inc(p);
|
||||
AName:=copy(Path,StartPos,p-StartPos);
|
||||
if not IsValidJSName(AName) then
|
||||
raise Exception.Create('invalid javascript class path: '+Path);
|
||||
IsLast:=p>Length(Path);
|
||||
if IsLast and not CreateLast then exit;
|
||||
// search class
|
||||
if Result=nil then begin
|
||||
AVLNode:=FindGlobal(AName);
|
||||
if AVLNode=nil then begin
|
||||
// create new global class
|
||||
debugln(['TJavascriptIdentifierTree.CreateClass new global class: ',AName]);
|
||||
Result:=TJSIClass.Create;
|
||||
Include(Result.Flags,jsicAutoCreated);
|
||||
Result.JSName:=AName;
|
||||
Globals.Add(Result);
|
||||
end else begin
|
||||
// class already exists
|
||||
if not (TObject(AVLNode.Data) is TJSIClass) then
|
||||
raise Exception.Create('path is not class: '+AName);
|
||||
Result:=TJSIClass(AVLNode.Data);
|
||||
end;
|
||||
end else begin
|
||||
Identifier:=Result.FindIdentifier(AName);
|
||||
if Identifier=nil then begin
|
||||
// create new sub class
|
||||
debugln(['TJavascriptIdentifierTree.CreateClass new sub class: ',AName,' of ',Result.JSName]);
|
||||
Parent:=Result;
|
||||
Result:=TJSIClass.Create;
|
||||
Include(Result.Flags,jsicAutoCreated);
|
||||
Result.JSName:=AName;
|
||||
Result.ParentClass:=Parent;
|
||||
Parent.AddClass(Result);
|
||||
end else if Identifier is TJSIClass then begin
|
||||
// sub class already exists
|
||||
Result:=TJSIClass(Identifier);
|
||||
end else if Identifier is TJSIProperty then begin
|
||||
// resolve property
|
||||
PropType:=TJSIProperty(Identifier).Typ;
|
||||
if PropType is TJSIClass then
|
||||
Result:=TJSIClass(PropType)
|
||||
else
|
||||
raise Exception.Create('path is not class: '+AName+' is '+Identifier.ClassName);
|
||||
end else begin
|
||||
raise Exception.Create('path is not class: '+AName+' is '+Identifier.ClassName);
|
||||
end;
|
||||
end;
|
||||
// skip point
|
||||
inc(p);
|
||||
until p>Length(Path);
|
||||
end;
|
||||
|
||||
function TJavascriptIdentifierTree.CreateAlias(const Path: string): TJSIAlias;
|
||||
var
|
||||
Context: TJSIClass;
|
||||
AVLNode: TAVLTreeNode;
|
||||
JSName: String;
|
||||
begin
|
||||
Context:=CreateClass(Path,false);
|
||||
if Context<>nil then
|
||||
raise Exception.Create('nested alias not spported yet: '+Path);
|
||||
JSName:=Path;
|
||||
AVLNode:=FindGlobal(JSName);
|
||||
if AVLNode=nil then begin
|
||||
// create new alias
|
||||
debugln(['TJavascriptIdentifierTree.CreateAlias new alias: ',JSName]);
|
||||
Result:=TJSIAlias.Create;
|
||||
Result.JSName:=JSName;
|
||||
end else begin
|
||||
// alias already exists
|
||||
if not (TObject(AVLNode.Data) is TJSIAlias) then
|
||||
raise Exception.Create('path not an alias: '+Path);
|
||||
Result:=TJSIAlias(AVLNode.Data);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TJavascriptIdentifierTree.FindGlobal(const aJSName: string
|
||||
): TAVLTreeNode;
|
||||
begin
|
||||
Result:=Globals.FindKey(Pointer(aJSName),@CompareJSNameWithJSIdentifier);
|
||||
end;
|
||||
|
||||
function TJavascriptIdentifierTree.CreateUnresolved(const aPath: string
|
||||
): TJSIUnresolvedIdentifier;
|
||||
begin
|
||||
if not IsValidJSName(aPath) then
|
||||
raise Exception.Create('invalid type name '+aPath);
|
||||
Result:=TJSIUnresolvedIdentifier.Create;
|
||||
Result.JSName:=aPath;
|
||||
end;
|
||||
|
||||
constructor TJavascriptIdentifierTree.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
Globals:=TAVLTree.Create(@CompareJSIdentifiers);
|
||||
end;
|
||||
|
||||
destructor TJavascriptIdentifierTree.Destroy;
|
||||
begin
|
||||
ClearGlobals;
|
||||
FreeAndNil(Globals);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TJavascriptIdentifierTree.LoadFromFile(Filename: string);
|
||||
var
|
||||
Doc: TXMLDocument;
|
||||
begin
|
||||
debugln(['TJavascriptIdentifierTree.LoadFromFile ',Filename]);
|
||||
ClearNodes;
|
||||
Doc:=nil;
|
||||
try
|
||||
ReadXMLFile(Doc,Filename);
|
||||
if (Doc.DocumentElement<>nil) and (Doc.DocumentElement.NodeName='ExtJSClasses') then
|
||||
ReadExtJSNodes(Doc.DocumentElement)
|
||||
else
|
||||
raise Exception.Create('ExtJSClasses not found in file '+Filename);
|
||||
finally
|
||||
Doc.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJavascriptIdentifierTree.ClearGlobals;
|
||||
begin
|
||||
Globals.FreeAndClear;
|
||||
end;
|
||||
|
||||
{ TJSIMethod }
|
||||
|
||||
destructor TJSIMethod.Destroy;
|
||||
begin
|
||||
ClearParams;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TJSIMethod.ClearParams;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if Params<>nil then
|
||||
for i:=0 to Params.Count-1 do TObject(Params[i]).Free;
|
||||
FreeAndNil(Params);
|
||||
end;
|
||||
|
||||
procedure TJSIMethod.AddParameter(aParam: TJSIParameter);
|
||||
begin
|
||||
if Params=nil then
|
||||
Params:=TFPList.Create;
|
||||
Params.Add(aParam);
|
||||
end;
|
||||
|
||||
{ TJSIClass }
|
||||
|
||||
destructor TJSIClass.Destroy;
|
||||
begin
|
||||
ClearClasses;
|
||||
ClearMethods;
|
||||
ClearProperties;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TJSIClass.ClearMethods;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if Methods<>nil then
|
||||
for i:=0 to Methods.Count-1 do TObject(Methods[i]).Free;
|
||||
FreeAndNil(Methods);
|
||||
end;
|
||||
|
||||
procedure TJSIClass.ClearProperties;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if Properties<>nil then
|
||||
for i:=0 to Properties.Count-1 do TObject(Properties[i]).Free;
|
||||
FreeAndNil(Properties);
|
||||
end;
|
||||
|
||||
procedure TJSIClass.ClearClasses;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if Classes<>nil then
|
||||
for i:=0 to Classes.Count-1 do TObject(Classes[i]).Free;
|
||||
FreeAndNil(Classes);
|
||||
end;
|
||||
|
||||
function TJSIClass.FindIdentifier(const AJSName: string): TJSIdentifier;
|
||||
|
||||
function Find(List: TFPList): TJSIdentifier;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if List=nil then exit(nil);
|
||||
for i:=0 to List.Count-1 do begin
|
||||
Result:=TJSIdentifier(List[i]);
|
||||
if CompareStr(AJSName,Result.JSName)=0 then exit;
|
||||
end;
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
begin
|
||||
Result:=Find(Classes);
|
||||
if Result<>nil then exit;
|
||||
Result:=Find(Properties);
|
||||
if Result<>nil then exit;
|
||||
Result:=Find(Methods);
|
||||
if Result<>nil then exit;
|
||||
end;
|
||||
|
||||
procedure TJSIClass.AddClass(AClass: TJSIClass);
|
||||
begin
|
||||
if Classes=nil then
|
||||
Classes:=TFPList.Create;
|
||||
Classes.Add(AClass);
|
||||
end;
|
||||
|
||||
procedure TJSIClass.AddMethod(AMethod: TJSIMethod);
|
||||
begin
|
||||
if Methods=nil then
|
||||
Methods:=TFPList.Create;
|
||||
Methods.Add(AMethod);
|
||||
end;
|
||||
|
||||
procedure TJSIClass.AddProperty(AProperty: TJSIProperty);
|
||||
begin
|
||||
if Properties=nil then
|
||||
Properties:=TFPList.Create;
|
||||
Properties.Add(AProperty);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user