liujianjun
/
tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

编辑器 

整理代码,以及优化编辑器提示
This commit is contained in:
JianjunLiu 2022-05-12 11:22:36 +08:00
parent 343d041a99
commit df9c3b8dbc
4 changed files with 229 additions and 272 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
designer/udesignerproject.tsf
View File

@ -3441,5 +3441,40 @@ E92946FC545E8EA1D20B8952E9954CA9F452AA3011854AAEE58A2A123445AF6A8
1CB3C87955C3470000000049454E44AE42608200";
return r ;
end
function GetPathFromFullName(fullname,fname,ftype);
begin
{**
@explan(说明) 获得当前执行tsl文件的所在路径 %%
@param(fullname)(string) 全名 %%
@param(fname)(string) 文件名 ,变参返回%%
@param(ftype)(string) 文件类型 ,变参返回%%
@return(string) 路径 %%
**}
ph := fullname;
n := "";
rp := "";
fname := "";
ftype := "";
firstd := true;
iofp := ioFileseparator();
for i := length(ph)downto 1 do
begin
vi := ph[i];
if vi="." and firstd then
begin
ftype := n;
n := "";
firstd := false;
end else
if vi=iofp then
begin
rp := ph[1:i-1];
break;
end else
n := vi+n;
end
FName := n;
return rp;
end
end.

188
designer/utslsynmemo.tsf
View File

@ -1595,6 +1595,54 @@ type TTsfFileParser = class //
return getprojecttsfs();
end
"parserstring":
begin
mtic;
r := parserstring(o,d);
return r;
end
end
end
private
function getinheriteds(r,m,dounits,us,uso,cs,cso);
begin
if not ifarray(us) then us := array();
if not ifarray(uso) then uso := array();
if not ifarray(cs) then cs := array();
if not ifarray(cso) then cso := array();
for i,v in r["units"] do
begin
vfn := checknamespacename(v);
if m=(lowercase(vfn)+".tsf") then continue;
vi := LoadByName(vfn);
if vi then
begin
if vi["msg"] in dounits then
begin
continue;
end
dounits[length(dounits)] := vi["msg"] ;
us[length(us)] := vfn;
uso[length(uso)] := vi;
getinheriteds(vi,m,dounits,us,uso,cs,cso);
end
end
for i,v in r["class"] do
begin
vfn := checknamespacename(v);
if m=(lowercase(vfn)+".tsf") then continue;
vi := LoadByName(vfn);
if vi then
begin
if vi["msg"] in dounits then continue;
dounits[length(dounits)] := vi["msg"];
cs[length(cs)] := vfn;
cso[length(cso)] := vi;
getinheriteds(vi,m,dounits,us,uso,cs,cso);
end
end
end
function parserstring(o,d);
begin
rti := 0;
rt := array();
@ -1602,7 +1650,6 @@ type TTsfFileParser = class //
if ifstring(m) then m := lowercase(m);
filechanged(m);
FormatFile(rti,FCacheS,rt,3,m);
if m and ifarray(FCacheS) then
begin
r := FCacheS[m];
@ -1628,148 +1675,28 @@ type TTsfFileParser = class //
FormatBlocks(rti,r["blcks"],rt,"",nil,ext,1);
FormatWords(rti,r["words"],rt,"",ext,1);
dounits := array(vmsg);
uout := array();
for i,v in r["units"] do //单元
getinheriteds(r,m,dounits,us,uso,cs,cso);
for i,v in us do //µ¥Ôª
begin
vfn := checknamespacename(v);
if m=(lowercase(vfn)+".tsf") then continue;
vi := LoadByName(vfn);
if vi then
begin
if vi["msg"] =vmsg then
begin
continue;
end
vfn := v;
vi := uso[i];
ext := array();
FormatFunction(rti,vi["functions"],rt,vfn,vi["lines"],ext,4);
FormatBlocks(rti,vi["blcks"],rt,vfn,nil,ext,4);
FormatWords(rti,vi["words"],rt,vfn,ext,4);
dounits[length(dounits)] := vi["msg"];
loadunits(vi["units"],dounits,uout);
end
end
//mtic;
for i,v in uout do
for i,v in cs do //Àà
begin
vfn := checknamespacename(v);
if m=(lowercase(vfn)+".tsf") then continue;
vi := LoadByName(vfn);
if vi then
begin
if vi["msg"] =vmsg then
begin
continue;
end
ext := array();
FormatFunction(rti,vi["functions"],rt,vfn,vi["lines"],ext,4);
end
end
uout := array();
//echo "\r\n other time:",mtoc;
dounits := array(vmsg);
for i,v in r["class"] do //类
begin
vfn := checknamespacename(v);
if m=(lowercase(vfn)+".tsf") then continue;
vi := LoadByName(vfn);
if vi then
begin
if vi["msg"] in dounits then continue;
vfn := v;
vi := cso[i];
ext:= array();
FormatFunction(rti,vi["functions"],rt,vfn,vi["lines"],ext,4);
FormatWords(rti,vi["words"],rt,vfn,ext,4);
//ident 文件名
loadclasses(vi["class"],dounits,uout);
end
end
for i,v in uout do
begin
vfn := checknamespacename(v);
if m=(lowercase(vfn)+".tsf") then continue;
vi := LoadByName(vfn);
if vi then
begin
if vi["msg"]=vmsg then continue;
ext:= array();
FormatFunction(rti,vi["functions"],rt,vfn,vi["lines"],ext,4);
FormatWords(rti,vi["words"],rt,vfn,ext,4);
end
end
//FormatFile(rti,FCacheS,rt,3,m);
return rt;
//return o.postmessage(r);
end
end
end
private
function loadunitcalss(us,cs,dounits,uout,cout);
begin
if not ifarray(uout) then uout := array();
if not ifarray(cout) then cout := array();
for i,v in us do
begin
vfn := checknamespacename(v);
vi := LoadByName(vfn);
if vi then
begin
if vi["msg"] in dounits then continue;
dounits[length(dounits)] := vi["msg"];
uout[length(uout)] := vfn;
loadunitcalss(vi["units"],vi["class"],dounits,uout,cout);
end
end
for i,v in cs do
begin
vfn := checknamespacename(v);
if m=(lowercase(vfn)+".tsf") then continue;
vi := LoadByName(vfn);
if vi then
begin
if vi["msg"] in dounits then continue;
dounits[length(dounits)] := vi["msg"];
//ident 文件名
cout[length(cout)] := vfn;
loadunitcalss(vi["units"],vi["class"],dounits,uout,cout);
end
end
end
function loadunits(us,dounits,uout);
begin
if not ifarray(uout) then uout := array();
for i,v in us do
begin
vfn := checknamespacename(v);
vi := LoadByName(vfn);
if vi then
begin
if vi["msg"] in dounits then continue;
dounits[length(dounits)] := vi["msg"];
uout[length(uout)] := vfn;
loadunits(vi["units"],dounits,uout);
end
end
end
function loadclasses(cs,dounits,uout);
begin
if not ifarray(uout) then uout := array();
for i,v in cs do
begin
vfn := checknamespacename(v);
if m=(lowercase(vfn)+".tsf") then continue;
vi := LoadByName(vfn);
if vi then
begin
if vi["msg"] in dounits then continue;
dounits[length(dounits)] := vi["msg"];
//ident 文件名
uout[length(uout)] := vfn;
loadclasses(cs,dounits,uout);
end
end
end
function checknamespacename(v);
begin
for ii in FCacheS do
@ -2056,7 +1983,7 @@ type TTsfFileParser = class //
ScriptDelBlocks(r["blcks"],str2array(rdd,"\n"),cls);
r["blcks"] := cls;
if not ifarray(FCacheS) then FCacheS := array();
FCacheS[fn] := r;
FCacheS[fn] := r;//new tparserdobject( r);
FFilePaths[fn] := pfn;
WriteParseredFile(fn,r,fl[0,"Time"]);
end
@ -2102,7 +2029,7 @@ type TTsfFileParser = class //
fn := FCacheDir+ioFileseparator()+ModifyFname(n)+".p";
if importfile(ftstream(),"",fn,d)=1 and ifarray(d) then
begin
FCacheS[lowercase(n)] := new tparserdobject(d);
FCacheS[lowercase(n)] := r;//new tparserdobject(d);
FFilePaths[lowercase(n)] := d["fullpath"];
return d;
end
@ -2157,6 +2084,7 @@ end
type tparserdobject = class
function create(d);
begin
echo "\r\n create f object===";
if ifarray(d) then
FData := d;
end

141
funcext/tvclib/tslvcl.tsf
View File

@ -33,22 +33,20 @@ Function tslcstructure(data,dsize,pack,ptr);
//function CompareRect(orect,nrect);
function calldatafunction();
//function CallMessgeFunction(f,o,e);
function CallMessgeFunction(f,o,e);
//////////////////////执行tsl脚本代码////////////////////
//function TSL_Check(func,funclen,oResult);
function CheckTslCode(code,err); //检查tsl语法
//function SysExecWait(handle,exe,cmd,dir,fui); //执行 win32 程序
function TS_ModulePath();
function TS_ExecPath();
function TS_GetAppPath();
//function TS_ModulePath();
//function TS_ExecPath();
//function TS_GetAppPath();
function TS_GetUserProfileHome();
function TS_GetIniPath(hometype,IniName);
//function TS_GetIniPath(hometype,IniName);
function CopyUsedTslDllToNewDir(p);
/////////////////////////////////////////////
function DeleteAllFiles(path);
function CreateDirWithFileName(fname);
function GetPathFromFullName(fullname,fname,ftype);
//************************
//*******************************
function MessageBoxA(txt,title,flag,hd);
@ -57,6 +55,9 @@ function _twinproc_(hwnd,message,wparam,lparam);//win32
function _MessgeHook_a(hwnd,message,wparam,lparam);
function remotetslcallback(data);
//********其他辅助函数*******
function TslToHexFormatStr(tsl);
function HexFormatStrToTsl(D);
function GetTextWidthAndHeightWidthFont(s,f,mul);
//**********操作系统相关函数*********************
function initlib();
////////////////////////////////////
@ -10369,45 +10370,6 @@ type TDragManager=class(TComponent)
property DragThreshold:Integer read FDragThreshold write FDragThreshold; // default 5;
end;
function GetPathFromFullName(fullname,fname,ftype);
begin
{**
@explan(说明) 获得当前执行tsl文件的所在路径 %%
@param(fullname)(string) 全名 %%
@param(fname)(string) 文件名 ,变参返回%%
@param(ftype)(string) 文件类型 ,变参返回%%
@return(string) 路径 %%
**}
ph := fullname;
n := "";
rp := "";
fname := "";
ftype := "";
firstd := true;
iofp := ioFileseparator();
for i := length(ph)downto 1 do
begin
vi := ph[i];
if vi="." and firstd then
begin
ftype := n;
n := "";
firstd := false;
end else
if vi=iofp then
begin
rp := ph[1:i-1];
break;
end else
n := vi+n;
end
FName := n;
return rp;
end
function GetAndDispatchMessageA(hwnd,minm,maxm);
begin
{**
@ -10778,11 +10740,11 @@ function TSL_NewObject():pointer;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$
function TSL_InterpGetLFromWrap(L:pointer):pointer;cdecl;external "TSSVRAPI.dll" name "TSL_InterpGetLFromWrap";
function TS_GetGlobalL():pointer;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetGlobalL";
function TSL_FreeObj(L:pointer;v:pointer);cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TSL_FreeObj";
function TS_ModulePath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ModulePath";
function TS_ExecPath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ExecPath";
function TS_GetAppPath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ExecPath";
//function TS_ModulePath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ModulePath";
//function TS_ExecPath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ExecPath";
//function TS_GetAppPath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ExecPath";
function TS_GetUserProfileHome():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetUserProfileHome";
function TS_GetIniPath(hometype:integer; var IniName:string):string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetIniPath";
//function TS_GetIniPath(hometype:integer; var IniName:string):string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetIniPath";
function TSL_Check(func:string;funclen:integer;oResult:pointer):integer;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TSL_Check";
procedure tslprocessmessages();begin {echo "\r\n processmessage";}end;
function RunWorkerThreadLoop();
@ -10800,71 +10762,12 @@ begin
end
function CreateDirWithFileName(fname);
begin
{**
@explan(说明) 根据文件全名构造目录 %%
**}
if not(ifstring(fname)and(length(fname)>4))then exit;
info := FileList("",fname);
if info then exit;
len := length(fname);
iofp := ioFileseparator();
for i := len downto 1 do
begin
vi := fname[i];
if vi=iofp then
begin
ffname := fname[1:i];
break;
end
end
if not ffname then exit;
nct := 4;
{$ifdef linux}
nct := 1;
{$endif}
ph := ffname[1:nct];
for i := nct+1 to length(ffname) do
begin
vi := ffname[i];
if vi=iofp then
begin
if not FileList("",ph)then
begin
CreateDir("",ph);
end
end
ph += vi;
end
return unit(utslvclauxiliary).CreateDirWithFileName(fname);
end
function DeleteAllFiles(path);
begin
{**
@explan(说明) 删除指定路径的文件或者文件夹 %%
**}
if not ifstring(path)then return 0;
if not path then return 0;
iofp := ioFileseparator();
if path[length(path)]=iofp then return call(thisfunction,path[1:(length(path)-1)]);
info := FileList("",path); //"A"
if info then
begin
if pos("D",info[0]["Attr"])then
begin
fs := FileList("",path+iofp+"*");
for i,v in fs do
begin
n := v["FileName"];
if n in array(".","..")then continue;
call(thisfunction,path+iofp+n);
end
return RemoveDir("",path);
end else
begin
return FileDelete("",path);
end
return 0;
end
return unit(utslvclauxiliary).DeleteAllFiles(path);
end
function LoginTslServer(usr,pwd,addr,port);
@ -11097,6 +11000,22 @@ begin
**}
return(a and not(b))or(b and not(a));
end
function TslToHexFormatStr(tsl);
begin
return unit(utslvclauxiliary).TslToHexFormatStr(tsl);
end
function HexFormatStrToTsl(D);
begin
return unit(utslvclauxiliary).HexFormatStrToTsl(d);
end
function GetTextWidthAndHeightWidthFont(s,f,mul);
begin
return unit(utslvclgdi).GetTextWidthAndHeightWidthFont(s,f,mul);
end
function CallMessgeFunction(f,o,e);
begin
return unit(utslvclauxiliary).CallMessgeFunction(f,o,e);
end
Initialization

75
funcext/tvclib/utslvclauxiliary.tsf
View File

@ -32,6 +32,9 @@ function ParserCommandLine(s); //
//function TslToHexStr(d);
function TslToHexFormatStr(tsl);
function HexFormatStrToTsl(D);
function DeleteAllFiles(path);
function CreateDirWithFileName(fname);
type tuiglobaldata=class
static UIData;
class Function uisetdata(n,d);
@ -1893,6 +1896,11 @@ begin
end
function TslToHexFormatStr(tsl);
begin
{**
@explan(说明) 将tsl类型转换为16进制字符串,每行长度为64,用\r\n分割 %%
@param(tsl)(any) tsl基础类型%%
@return(string) 字符串形式的16进制 %%
**}
s := TslToHexStr(tsl);
r := "";
n := length(s);
@ -2119,6 +2127,73 @@ begin
end
return array(0,0);
end
function DeleteAllFiles(path);
begin
{**
@explan(说明) 删除指定路径的文件或者文件夹 %%
**}
if not ifstring(path)then return 0;
if not path then return 0;
iofp := ioFileseparator();
if path[length(path)]=iofp then return call(thisfunction,path[1:(length(path)-1)]);
info := FileList("",path); //"A"
if info then
begin
if pos("D",info[0]["Attr"])then
begin
fs := FileList("",path+iofp+"*");
for i,v in fs do
begin
n := v["FileName"];
if n in array(".","..")then continue;
call(thisfunction,path+iofp+n);
end
return RemoveDir("",path);
end else
begin
return FileDelete("",path);
end
return 0;
end
end
function CreateDirWithFileName(fname);
begin
{**
@explan(说明) 根据文件全名构造目录 %%
**}
if not(ifstring(fname)and(length(fname)>4))then exit;
info := FileList("",fname);
if info then exit;
len := length(fname);
iofp := ioFileseparator();
for i := len downto 1 do
begin
vi := fname[i];
if vi=iofp then
begin
ffname := fname[1:i];
break;
end
end
if not ffname then exit;
nct := 4;
{$ifdef linux}
nct := 1;
{$endif}
ph := ffname[1:nct];
for i := nct+1 to length(ffname) do
begin
vi := ffname[i];
if vi=iofp then
begin
if not FileList("",ph)then
begin
CreateDir("",ph);
end
end
ph += vi;
end
end
initialization