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"; 1CB3C87955C3470000000049454E44AE42608200";
return r ; return r ;
end 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. end.

226
designer/utslsynmemo.tsf
View File

@ -1596,130 +1596,37 @@ type TTsfFileParser = class //
end end
"parserstring": "parserstring":
begin begin
rti := 0; mtic;
rt := array(); r := parserstring(o,d);
m := d["minus"]; return r;
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];
end
if r then
begin
//echo "\r\nlodad";
vmsg := r["msg"];
end else
begin
s := d["value"];
if not(s and ifstring(s)) then return rt ;
r := tsl_tokenizeex_2_(s,1);
if not( r and ifarray(r)) then return rt;
cls := array();
ScriptDelBlocks(r["blcks"],str2array(s,"\n"),cls);
r["blcks"] := cls;
vmsg := getmsgd_Crc32(s);//GetMsgdigest(s,0);
end
ext := array();
FormatFunction(rti,r["functions"],rt,"",r["lines"],ext,1);
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 //单元
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);
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
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;
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 end
end end
private private
function loadunitcalss(us,cs,dounits,uout,cout); function getinheriteds(r,m,dounits,us,uso,cs,cso);
begin begin
if not ifarray(uout) then uout := array(); if not ifarray(us) then us := array();
if not ifarray(cout) then cout := array(); if not ifarray(uso) then uso := array();
for i,v in us do if not ifarray(cs) then cs := array();
if not ifarray(cso) then cso := array();
for i,v in r["units"] do
begin begin
vfn := checknamespacename(v); vfn := checknamespacename(v);
if m=(lowercase(vfn)+".tsf") then continue;
vi := LoadByName(vfn); vi := LoadByName(vfn);
if vi then if vi then
begin begin
if vi["msg"] in dounits then continue; if vi["msg"] in dounits then
dounits[length(dounits)] := vi["msg"]; begin
uout[length(uout)] := vfn; continue;
loadunitcalss(vi["units"],vi["class"],dounits,uout,cout); end
dounits[length(dounits)] := vi["msg"] ;
us[length(us)] := vfn;
uso[length(uso)] := vi;
getinheriteds(vi,m,dounits,us,uso,cs,cso);
end end
end end
for i,v in cs do for i,v in r["class"] do
begin begin
vfn := checknamespacename(v); vfn := checknamespacename(v);
if m=(lowercase(vfn)+".tsf") then continue; if m=(lowercase(vfn)+".tsf") then continue;
@ -1728,48 +1635,68 @@ type TTsfFileParser = class //
begin begin
if vi["msg"] in dounits then continue; if vi["msg"] in dounits then continue;
dounits[length(dounits)] := vi["msg"]; dounits[length(dounits)] := vi["msg"];
//ident 文件名 cs[length(cs)] := vfn;
cout[length(cout)] := vfn; cso[length(cso)] := vi;
loadunitcalss(vi["units"],vi["class"],dounits,uout,cout); getinheriteds(vi,m,dounits,us,uso,cs,cso);
end end
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 end
function loadclasses(cs,dounits,uout); function parserstring(o,d);
begin begin
if not ifarray(uout) then uout := array(); rti := 0;
for i,v in cs do rt := array();
m := d["minus"];
if ifstring(m) then m := lowercase(m);
filechanged(m);
FormatFile(rti,FCacheS,rt,3,m);
if m and ifarray(FCacheS) then
begin begin
vfn := checknamespacename(v); r := FCacheS[m];
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
end if r then
begin
//echo "\r\nlodad";
vmsg := r["msg"];
end else
begin
s := d["value"];
if not(s and ifstring(s)) then return rt ;
r := tsl_tokenizeex_2_(s,1);
if not( r and ifarray(r)) then return rt;
cls := array();
ScriptDelBlocks(r["blcks"],str2array(s,"\n"),cls);
r["blcks"] := cls;
vmsg := getmsgd_Crc32(s);//GetMsgdigest(s,0);
end
ext := array();
FormatFunction(rti,r["functions"],rt,"",r["lines"],ext,1);
FormatBlocks(rti,r["blcks"],rt,"",nil,ext,1);
FormatWords(rti,r["words"],rt,"",ext,1);
dounits := array(vmsg);
getinheriteds(r,m,dounits,us,uso,cs,cso);
for i,v in us do //µ¥Ôª
begin
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);
end
for i,v in cs do //Àà
begin
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);
end
//FormatFile(rti,FCacheS,rt,3,m);
return rt;
//return o.postmessage(r);
end
function checknamespacename(v); function checknamespacename(v);
begin begin
for ii in FCacheS do for ii in FCacheS do
@ -2056,7 +1983,7 @@ type TTsfFileParser = class //
ScriptDelBlocks(r["blcks"],str2array(rdd,"\n"),cls); ScriptDelBlocks(r["blcks"],str2array(rdd,"\n"),cls);
r["blcks"] := cls; r["blcks"] := cls;
if not ifarray(FCacheS) then FCacheS := array(); if not ifarray(FCacheS) then FCacheS := array();
FCacheS[fn] := r; FCacheS[fn] := r;//new tparserdobject( r);
FFilePaths[fn] := pfn; FFilePaths[fn] := pfn;
WriteParseredFile(fn,r,fl[0,"Time"]); WriteParseredFile(fn,r,fl[0,"Time"]);
end end
@ -2102,7 +2029,7 @@ type TTsfFileParser = class //
fn := FCacheDir+ioFileseparator()+ModifyFname(n)+".p"; fn := FCacheDir+ioFileseparator()+ModifyFname(n)+".p";
if importfile(ftstream(),"",fn,d)=1 and ifarray(d) then if importfile(ftstream(),"",fn,d)=1 and ifarray(d) then
begin begin
FCacheS[lowercase(n)] := new tparserdobject(d); FCacheS[lowercase(n)] := r;//new tparserdobject(d);
FFilePaths[lowercase(n)] := d["fullpath"]; FFilePaths[lowercase(n)] := d["fullpath"];
return d; return d;
end end
@ -2157,6 +2084,7 @@ end
type tparserdobject = class type tparserdobject = class
function create(d); function create(d);
begin begin
echo "\r\n create f object===";
if ifarray(d) then if ifarray(d) then
FData := d; FData := d;
end end

141
funcext/tvclib/tslvcl.tsf
View File

@ -33,22 +33,20 @@ Function tslcstructure(data,dsize,pack,ptr);
//function CompareRect(orect,nrect); //function CompareRect(orect,nrect);
function calldatafunction(); function calldatafunction();
//function CallMessgeFunction(f,o,e); function CallMessgeFunction(f,o,e);
//////////////////////执行tsl脚本代码//////////////////// //////////////////////执行tsl脚本代码////////////////////
//function TSL_Check(func,funclen,oResult); //function TSL_Check(func,funclen,oResult);
function CheckTslCode(code,err); //检查tsl语法 function CheckTslCode(code,err); //检查tsl语法
//function SysExecWait(handle,exe,cmd,dir,fui); //执行 win32 程序 //function SysExecWait(handle,exe,cmd,dir,fui); //执行 win32 程序
function TS_ModulePath(); //function TS_ModulePath();
function TS_ExecPath(); //function TS_ExecPath();
function TS_GetAppPath(); //function TS_GetAppPath();
function TS_GetUserProfileHome(); function TS_GetUserProfileHome();
function TS_GetIniPath(hometype,IniName); //function TS_GetIniPath(hometype,IniName);
function CopyUsedTslDllToNewDir(p); function CopyUsedTslDllToNewDir(p);
///////////////////////////////////////////// /////////////////////////////////////////////
function DeleteAllFiles(path); function DeleteAllFiles(path);
function CreateDirWithFileName(fname); function CreateDirWithFileName(fname);
function GetPathFromFullName(fullname,fname,ftype);
//************************ //************************
//******************************* //*******************************
function MessageBoxA(txt,title,flag,hd); 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 _MessgeHook_a(hwnd,message,wparam,lparam);
function remotetslcallback(data); function remotetslcallback(data);
//********其他辅助函数******* //********其他辅助函数*******
function TslToHexFormatStr(tsl);
function HexFormatStrToTsl(D);
function GetTextWidthAndHeightWidthFont(s,f,mul);
//**********操作系统相关函数********************* //**********操作系统相关函数*********************
function initlib(); function initlib();
//////////////////////////////////// ////////////////////////////////////
@ -10369,45 +10370,6 @@ type TDragManager=class(TComponent)
property DragThreshold:Integer read FDragThreshold write FDragThreshold; // default 5; property DragThreshold:Integer read FDragThreshold write FDragThreshold; // default 5;
end; 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); function GetAndDispatchMessageA(hwnd,minm,maxm);
begin 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 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 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 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_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_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_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_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"; 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; procedure tslprocessmessages();begin {echo "\r\n processmessage";}end;
function RunWorkerThreadLoop(); function RunWorkerThreadLoop();
@ -10800,71 +10762,12 @@ begin
end end
function CreateDirWithFileName(fname); function CreateDirWithFileName(fname);
begin begin
{** return unit(utslvclauxiliary).CreateDirWithFileName(fname);
@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 end
function DeleteAllFiles(path); function DeleteAllFiles(path);
begin begin
{** return unit(utslvclauxiliary).DeleteAllFiles(path);
@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 end
function LoginTslServer(usr,pwd,addr,port); function LoginTslServer(usr,pwd,addr,port);
@ -11097,6 +11000,22 @@ begin
**} **}
return(a and not(b))or(b and not(a)); return(a and not(b))or(b and not(a));
end 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 Initialization

77
funcext/tvclib/utslvclauxiliary.tsf
View File

@ -32,6 +32,9 @@ function ParserCommandLine(s); //
//function TslToHexStr(d); //function TslToHexStr(d);
function TslToHexFormatStr(tsl); function TslToHexFormatStr(tsl);
function HexFormatStrToTsl(D); function HexFormatStrToTsl(D);
function DeleteAllFiles(path);
function CreateDirWithFileName(fname);
type tuiglobaldata=class type tuiglobaldata=class
static UIData; static UIData;
class Function uisetdata(n,d); class Function uisetdata(n,d);
@ -1893,6 +1896,11 @@ begin
end end
function TslToHexFormatStr(tsl); function TslToHexFormatStr(tsl);
begin begin
{**
@explan(说明) 将tsl类型转换为16进制字符串,每行长度为64,用\r\n分割 %%
@param(tsl)(any) tsl基础类型%%
@return(string) 字符串形式的16进制 %%
**}
s := TslToHexStr(tsl); s := TslToHexStr(tsl);
r := ""; r := "";
n := length(s); n := length(s);
@ -1907,7 +1915,7 @@ begin
r += s[i:n]; r += s[i:n];
break; break;
end else end else
r += s[i:ij]; r += s[i:ij];
if ij>n then break; if ij>n then break;
r += "\r\n"; r += "\r\n";
i := ij+1; i := ij+1;
@ -2119,6 +2127,73 @@ begin
end end
return array(0,0); return array(0,0);
end 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 initialization