1593 lines
51 KiB
Plaintext
1593 lines
51 KiB
Plaintext
unit UTslCodeFormat;
|
|
interface
|
|
uses utslvclauxiliary;
|
|
//TSL代码格式化 code 为代码,tabwidth 为缩进空格数 LineWordCount 为单行最大的词数目 linelength 字符最多个数
|
|
//20210311 美化了函数定义换行的问题
|
|
//20210406 LineWordCount linelength 两个参数已经不起作用
|
|
//20210308 添加 ABComment 参数,控制块注释的行首缩进
|
|
//20220914 移动tire树到 utslvclauxiliary
|
|
function FormatTsl(Code,tabwidth,LineWordCount,linelength,arraytype,ABComment);
|
|
type TTslFParser = class(TFormatParser)
|
|
function Create();
|
|
begin
|
|
inherited;
|
|
end
|
|
end
|
|
implementation
|
|
function FormatTsl(Code,tabwidth,LineWordCount,linelength,arraytype,AlignBlockComment);
|
|
begin
|
|
pser := static new TFormatParser();
|
|
pser.Script := code;
|
|
pser.ArrayType := ArrayType;
|
|
if tabwidth>1 then pser.HierarchyWidth := tabwidth;
|
|
pser.AlignBlockComment := AlignBlockComment;
|
|
//if LineWordCount>0 or LineWordCount<0 then pser.MaxLineCount := LineWordCount;
|
|
//if linelength>0 or linelength<0 then pser.MaxLineLength := linelength;
|
|
return pser.FormatCode();
|
|
end
|
|
type TFormatParser = class
|
|
TK_STR; //字符串
|
|
TK_W; //变量
|
|
TK_C; //各种注释
|
|
TK_C_S; //单行注释
|
|
TK_C_D1; //多行 {
|
|
TK_C_D2; //多行 (*
|
|
TK_SYN ;//符号
|
|
TK_SYN_S;//分离符号
|
|
TK_TSLX ;// 注释
|
|
TK_KEY;
|
|
TK_TYPE;
|
|
TK_CLASS;
|
|
TK_FUNCTION;
|
|
TK_SELECT;
|
|
TK_UNIT;
|
|
TK_IF;
|
|
TK_THEN;
|
|
TK_ELSE;
|
|
TK_BEGIN;
|
|
TK_END;
|
|
TK_TRY;
|
|
TK_EXCEPT;
|
|
TK_FINALLY;
|
|
TK_CASE;
|
|
TK_OF;
|
|
|
|
TK_EXTERNAL ;
|
|
TK_CDECL ;
|
|
TK_STDCALL ;
|
|
TK_NAME ;
|
|
TK_keepresident ;
|
|
TK_OPERATOR;
|
|
TK_PRIVATE;
|
|
TK_ARRAY;
|
|
TK_NEW;
|
|
TK_DO;
|
|
BT_DEF;
|
|
BT_UNIT;
|
|
BT_TYPE;
|
|
|
|
BT_BEGIN;
|
|
BT_CASE;
|
|
BT_SELECT;
|
|
BT_TRY;
|
|
BT_ARRAY;
|
|
BT_CALC;
|
|
FSynParser;
|
|
FSynParser2;
|
|
FHtmlParser;
|
|
function Create();
|
|
begin
|
|
TK_STR := 1; //字符串
|
|
TK_W := 2; //变量
|
|
TK_C := 4; //各种注释
|
|
TK_C_S := 8; //单行注释
|
|
TK_C_D1 := 16; //多行 {
|
|
TK_C_D2 := 32 ; //多行 (*
|
|
TK_SYN := 64;//符号
|
|
TK_SYN_S := 128;//分离符号
|
|
TK_TSLX := 256;// 注释
|
|
TK_KEY := 512;
|
|
//子类型
|
|
TK_TYPE := 1;
|
|
TK_CLASS := 2;
|
|
TK_FUNCTION := 4;
|
|
TK_SELECT := 8;
|
|
TK_UNIT:=16;
|
|
TK_IF := 32;
|
|
TK_THEN := 64;
|
|
TK_ELSE := 128;
|
|
TK_BEGIN := 256 ;
|
|
TK_END := 512;
|
|
TK_TRY := 1024;
|
|
TK_EXCEPT := 2048;
|
|
TK_FINALLY := 4096;
|
|
TK_CASE := 8192;
|
|
TK_OF := 16384;
|
|
n := 15;
|
|
TK_EXTERNAL := 2^(n++);
|
|
TK_CDECL := 2^(n++);
|
|
TK_STDCALL := 2^(n++);
|
|
TK_NAME := 2^(n++);
|
|
TK_keepresident :=2^(n++);
|
|
TK_PRIVATE := 2^(n++);
|
|
TK_ARRAY := 2^(n++);
|
|
TK_NEW := 2^(n++);
|
|
TK_DO := 2^(n++);
|
|
//..............................
|
|
BT_DEF := 1;
|
|
BT_UNIT := 1+2;
|
|
BT_TYPE := 1+4;
|
|
BT_BEGIN := 8;
|
|
BT_CASE := 8+16;
|
|
BT_SELECT := 8+32;
|
|
BT_TRY := 8+64;
|
|
BT_ARRAY := 8+128;
|
|
BT_CALC := 8+256;
|
|
//.................................
|
|
FHierarchyWidth := 4;
|
|
TslSyn := array(":=","<>",">=","<=",".>",".<",".>=",".<=",".=","++","--","?:",".!!",".&&",".||",".&",".|",".^",
|
|
":*",":/",":\\",":^",":|","::","::=","->",
|
|
"+=","-=","*=","/=","\\=","^=","~=","%=",".|=",".&=",".||=",".&&=",".^=","|=",":|=","&=",":*=",":/=",":\\=",":^=",
|
|
//"div=","union2=","intersect=","outersect=","minus=","end.",
|
|
"##","l'",'l"',"*",
|
|
"%%","(*","//","#!",
|
|
"<?tslx>",
|
|
"?>",
|
|
//"0x","0O","0b",
|
|
);
|
|
TslSyn2 := array("div=","union2=","intersect=","outersect=","minus=","end.",);
|
|
// "union2=","intersect=","outersect=","minus=","end.",
|
|
FMaxLineCount := 20;
|
|
FMaxLineLength := -1;
|
|
FSynParser := new TTire();
|
|
FSynParser2 := new TTire();
|
|
for i,v in TslSyn do
|
|
begin
|
|
FSynParser.add(v);
|
|
end
|
|
for i,v in TslSyn2 do
|
|
begin
|
|
FSynParser2.add(v);
|
|
end
|
|
FHtmlParser := NEW TTire();
|
|
FHtmlParser.Add("<?tsl");
|
|
FArrayType := 1;
|
|
end
|
|
FTkIndex; //当前位置
|
|
FCWordCount; //当前行单词数目
|
|
FLWordLength; //当前行字符串长度
|
|
FTokenslength; //token的总长度;
|
|
FHier;
|
|
FFormatStr;
|
|
Fstates;
|
|
FMaxLineCount;
|
|
FMaxLineLength;
|
|
function DelTokens();
|
|
begin
|
|
FTkIndex := 0;
|
|
FCWordCount := 0;
|
|
FLWordLength := 0;
|
|
FTokenslength := length(FTokens);
|
|
FHier := new THStack(FHierarchyWidth);
|
|
Fstates := new TStateStack();
|
|
Fstates.Push(BT_DEF);
|
|
FFormatStr := "";
|
|
end
|
|
function GetNextNComTk(cidx);
|
|
begin
|
|
Cidx := FTkIndex;
|
|
while (cidx+1)<FTokenslength do
|
|
begin
|
|
cidx++;
|
|
tk := FTokens[Cidx];
|
|
if ifnil(tk) then return 0;
|
|
if tk.FType .& TK_C then continue;
|
|
return tk;
|
|
end
|
|
end
|
|
function NextNComTk();
|
|
begin
|
|
r := GetNextNComTk(cidx);
|
|
FTkIndex := cidx;
|
|
return r;
|
|
end
|
|
function NextTK();
|
|
begin
|
|
if FTkIndex<FTokenslength then
|
|
begin
|
|
FTkIndex++;
|
|
return FTokens[FTkIndex];
|
|
end
|
|
end
|
|
function GetNextTK();
|
|
begin
|
|
return FTokens[FTkIndex+1];
|
|
end
|
|
function CurrentTK();
|
|
begin
|
|
return FTokens[FTkIndex];
|
|
end
|
|
function GetPrevTK(cid);
|
|
begin
|
|
cidx := FTkIndex;
|
|
if cidx>=1 then return FTokens[cidx-1];
|
|
end
|
|
function PrevTK();
|
|
begin
|
|
if FTkIndex>0 then
|
|
begin
|
|
FTkIndex--;
|
|
return FTokens[FTkIndex];
|
|
end
|
|
end
|
|
function PrevNComTK();
|
|
begin
|
|
while FTkIndex>0 do
|
|
begin
|
|
FTkIndex--;
|
|
tk := FTokens[FTkIndex];
|
|
if tk.FType .& TK_C then continue;
|
|
return tk;
|
|
end
|
|
end
|
|
function GetPrevNComTK(cidx);
|
|
begin
|
|
cidx := FTkIndex;
|
|
while cidx>0 do
|
|
begin
|
|
cidx--;
|
|
tk := FTokens[cidx];
|
|
if tk.FType .& TK_C then
|
|
begin
|
|
continue;
|
|
end
|
|
return tk;
|
|
end
|
|
end
|
|
function ChangeLine();
|
|
begin
|
|
if FCWordCount then
|
|
begin
|
|
FFormatStr+="\r\n";
|
|
FCWordCount := 0;
|
|
FLWordLength := 0;
|
|
end
|
|
end
|
|
function AddTokenToStr(idx);
|
|
begin
|
|
tk := FTokens[idx];
|
|
if not tk then return ;
|
|
bidx := FTkIndex;
|
|
FTkIndex := idx;
|
|
{if idx>1 and (tk.FType .& TK_KEY) and (tk.FTypeSub .& TK_ELSE) and (ptk := GetPrevTK(ttidx)) and (ptk.FTypeSub .& TK_END) then //else处理
|
|
begin
|
|
fl := length(FFormatStr);
|
|
if FFormatStr[fl]="\n" then
|
|
begin
|
|
FFormatStr[fl-5] := ptk.FStr+" "+tk.FStr+"\r\n";
|
|
end else
|
|
begin
|
|
FCWordCount++;
|
|
FLWordLength+=tk.FStrL;
|
|
end
|
|
|
|
end else }
|
|
fl := length(FFormatStr);
|
|
if idx>1 and (tk.FType .& TK_KEY) and (tk.FTypeSub .& TK_ELSE) and (ptk := GetPrevTK(ttidx)) and (ptk.FTypeSub .& TK_END) and (FFormatStr[fl]="\n") then //else处理
|
|
begin
|
|
FFormatStr[fl-1:] := " "+tk.FStr+"\r\n";
|
|
FCWordCount := 0;
|
|
FLWordLength := 0;
|
|
end else
|
|
if (tk.FType .& TK_C_S) and tk.FFirst=0 then
|
|
begin
|
|
fl := length(FFormatStr);
|
|
if fl>2 and (FFormatStr[fl-1:fl]="\r\n") then
|
|
begin
|
|
FFormatStr[fl-1:fl]:=" "+tk.FStr+"\r\n";
|
|
end
|
|
else FFormatStr+= " "+tk.FStr+ "\r\n";
|
|
FCWordCount :=0;
|
|
FLWordLength :=0;
|
|
end else
|
|
if (tk.FType .& TK_SYN_S){ and (tk.FStr="*")} then //修正(**) 问题 20231127修正
|
|
begin
|
|
FFormatStr+= " "+tk.FStr+" ";
|
|
end else
|
|
if (tk.FType .& TK_SYN) and (tk.FStr=";") then
|
|
begin
|
|
fl := length(FFormatStr);
|
|
if fl>2 and (FFormatStr[fl-1:fl]="\r\n") then
|
|
begin
|
|
FFormatStr[fl-1:fl]:=";\r\n";
|
|
end
|
|
else FFormatStr+=";\r\n";
|
|
FCWordCount :=0;
|
|
FLWordLength :=0;
|
|
end else
|
|
if (tk.FType .& TK_KEY) and ((tk.FTypeSub .& TK_PRIVATE)) then
|
|
begin
|
|
ChangeLine();
|
|
FFormatStr+= FHier.HierStr()+ tk.FStr+"\r\n";
|
|
end else
|
|
if tk.FType .& TK_C then
|
|
begin
|
|
//单行
|
|
if tk.FType .& TK_C_S then
|
|
begin
|
|
|
|
if FCWordCount then
|
|
begin
|
|
FFormatStr +=" "+tk.FStr;
|
|
end else
|
|
begin
|
|
FFormatStr+= FHier.HierStr()+ tk.FStr;
|
|
end
|
|
FFormatStr+="\r\n";
|
|
FCWordCount := 0;
|
|
FLWordLength := 0;
|
|
//ChangeLine();
|
|
end else
|
|
begin
|
|
//多行
|
|
mcs := tk.FStr;
|
|
if FAlignBlockComment then
|
|
begin
|
|
mcss := str2array(mcs,"\n");
|
|
lenmcss := length(mcss);
|
|
if lenmcss>1 then
|
|
begin
|
|
mcs := mcss[0]+"\n";
|
|
for i,v in mcss do
|
|
begin
|
|
if i=0 then continue;
|
|
cz := false;
|
|
for j:= 1 to length(v) do
|
|
begin
|
|
if v[j] in array(" ","\t","\r") then continue;
|
|
cz := true;
|
|
break;
|
|
end
|
|
if cz then
|
|
begin
|
|
vs := v;
|
|
vs[1:j-1]:=FHier.HierStr();
|
|
mcs +=vs;
|
|
end else
|
|
begin
|
|
mcs+=v;
|
|
end
|
|
if lenmcss>i+1 then
|
|
begin
|
|
mcs+="\n";
|
|
end
|
|
end
|
|
|
|
end
|
|
//mcs := replacetext(mcs,"\r\n","\r\n"+FHier.HierStr()) ;
|
|
end
|
|
if tk.FFirst then
|
|
begin
|
|
ChangeLine();
|
|
end
|
|
if FCWordCount then FFormatStr+= " "+ mcs;
|
|
else
|
|
FFormatStr+= FHier.HierStr()+ mcs;
|
|
ttk := GetNextTK();
|
|
if ttk and ttk.FFirst then
|
|
begin
|
|
FFormatStr+="\r\n";
|
|
FCWordCount := 0;
|
|
FLWordLength := 0;
|
|
end
|
|
else FCWordCount++;
|
|
end
|
|
|
|
end else
|
|
begin
|
|
state := Fstates.GetState();
|
|
|
|
if ((state = BT_ARRAY and FArrayType=0) or (state = BT_SELECT)) and tk.FFirst then
|
|
begin
|
|
if FCWordCount then
|
|
begin
|
|
FCWordCount := 0;
|
|
FLWordLength := 0;
|
|
FFormatStr+="\r\n";
|
|
end
|
|
end
|
|
if FCWordCount then
|
|
begin
|
|
ttk := GetPrevTK();
|
|
if ttk and ( (tk.FTypeSub .& TK_DO) or (tk.FTypeSub .& TK_END) or (((ttk.FType .& TK_W) or (ttk.FType .& TK_KEY) or (ttk.FType .& TK_STR) ) and ((tk.FType .& TK_W) or (tk.FType .& TK_KEY) or (tk.FType .& TK_STR))) ) then
|
|
// if ttk and ((ttk.FType .& TK_W) or (ttk.FType .& TK_KEY)) or ((tk.FType .& TK_W) or (tk.FType .& TK_KEY)) then
|
|
begin
|
|
FFormatStr+=" "+tk.FStr;
|
|
end
|
|
else FFormatStr+=tk.FStr
|
|
end else
|
|
begin
|
|
FFormatStr+=FHier.HierStr()+tk.FStr;
|
|
end
|
|
FCWordCount++;
|
|
FLWordLength+=tk.FStrL;
|
|
if false and ((FMaxLineCount>0 and FCWordCount>=FMaxLineCount) or (FMaxLineLength>5 and FMaxLineLength <FLWordLength )) then
|
|
begin
|
|
ChangeLine();
|
|
end
|
|
|
|
end
|
|
FTkIndex := bidx;
|
|
|
|
end
|
|
function Formataline(b,e);
|
|
begin
|
|
bct := FCWordCount;
|
|
s := FTokens[b].FStr;
|
|
fbktkindex := FTkIndex;
|
|
FCWordCount++ ; FLWordLength +=FTokens[b].FStrL;
|
|
for i:= b+1 to e do
|
|
begin
|
|
|
|
//FTkIndex := i;
|
|
ttk := FTokens[i-1];
|
|
tk := FTokens[i];
|
|
FCWordCount++ ; FLWordLength +=tk.FStrL;
|
|
//if ((ttk.FType .& TK_W) or (ttk.FType .& TK_KEY)) and ((PTK.FType .& TK_W) or (PTK.FType .& TK_KEY)) then s+=" ";
|
|
if ttk and ( (tk.FTypeSub .& TK_DO) or (tk.FTypeSub .& TK_END) or (((ttk.FType .& TK_W) or (ttk.FType .& TK_KEY) or (ttk.FType .& TK_STR) ) and ((tk.FType .& TK_W) or (tk.FType .& TK_KEY) or (tk.FType .& TK_STR))) ) then
|
|
begin
|
|
s+=" ";
|
|
end
|
|
if (tk.FType .& TK_C_S) and tk.FFirst then
|
|
begin
|
|
s+="\r\n";
|
|
if i<e then s+=FHier.HierStr();
|
|
FCWordCount := 0;
|
|
FLWordLength :=0;
|
|
end
|
|
s += tk.FStr;
|
|
if tk.FType .& TK_C_S then
|
|
begin
|
|
s+="\r\n";
|
|
FCWordCount := 0;
|
|
FLWordLength :=0;
|
|
end
|
|
|
|
end
|
|
FFormatStr += ((bct=0)? FHier.HierStr():" ")+s;
|
|
//FTkIndex := fbktkindex;
|
|
return s;
|
|
end
|
|
function Findftokens();
|
|
begin
|
|
ntk := NextNComTk();
|
|
if not(ntk) or ntk.FStr=";" then
|
|
begin
|
|
return 0;
|
|
end
|
|
//ntk := NextNComTk();
|
|
//state "hsm","cs" "tp","ext" "plus"
|
|
{
|
|
hsm ( cs
|
|
hsm 其他 hsm
|
|
hsm ; ext
|
|
hsm : tp
|
|
cs ) tp
|
|
tp ; plus
|
|
plus ; plus
|
|
plus virtual plus
|
|
plus override plus
|
|
plus overload plus
|
|
plus stdcall -- 下一个 external
|
|
plus 其他 结束
|
|
plus external -- 获得小一个
|
|
}
|
|
hsidx := 0;
|
|
nhsmame := false;
|
|
hssmok := false;
|
|
st := "hsm";
|
|
while ntk do
|
|
begin
|
|
hsidx++;
|
|
s := ntk.FStr;
|
|
ft := ntk.FType;
|
|
fts := ntk.FTypeSub;
|
|
ls := lowercase(s);
|
|
case st of
|
|
"hsm":
|
|
begin
|
|
case s of
|
|
"(":
|
|
begin
|
|
if hsidx = 1 then
|
|
begin
|
|
nhsmame := true;
|
|
end
|
|
st := "cs";
|
|
end
|
|
";": st := "plus";
|
|
":": st := "tp";
|
|
end ;
|
|
if (fts .& TK_BEGIN) then
|
|
begin
|
|
goto jump1;
|
|
end
|
|
end
|
|
"cs":
|
|
begin
|
|
if s=")" then st := "tp";
|
|
end
|
|
"tp":
|
|
begin
|
|
if s =";" then st := "plus";
|
|
else if s=":" then
|
|
begin
|
|
ntk := NextNComTk();
|
|
end else
|
|
if s = "array" then
|
|
begin
|
|
|
|
end else
|
|
if s="of" then
|
|
begin
|
|
ntk := NextNComTk();
|
|
end
|
|
else
|
|
if (fts .& TK_BEGIN) then
|
|
begin
|
|
goto jump1;
|
|
end else
|
|
begin
|
|
goto jump1;
|
|
end
|
|
end
|
|
"plus":
|
|
begin
|
|
if ls in array("virtual","override","overload","stdcall","cdecl") then
|
|
begin
|
|
end else
|
|
if ls=";" then
|
|
begin
|
|
hssmok := true;
|
|
end
|
|
else
|
|
if ls in array( "external") then
|
|
begin
|
|
st := "ext";
|
|
end else
|
|
if (fts .& TK_BEGIN) then
|
|
begin
|
|
goto jump1;
|
|
end else
|
|
begin
|
|
goto jump1;
|
|
end
|
|
end
|
|
"ext":
|
|
begin
|
|
if ls in array("name","keepresident") then
|
|
begin
|
|
|
|
end else
|
|
if (ft .& TK_STR) then
|
|
begin
|
|
|
|
end else
|
|
if (s =";") then
|
|
begin
|
|
goto jump2;
|
|
end
|
|
end
|
|
|
|
end ;
|
|
ntk := NextNComTk();
|
|
end
|
|
//if st<>"hsm" then return 1 ;
|
|
if hssmok then
|
|
begin
|
|
goto jump1;
|
|
end
|
|
return 0;
|
|
label jump1;
|
|
PrevNComTK();
|
|
//PrevTK();
|
|
if nhsmame then return 3;
|
|
return 1;
|
|
label jump2;
|
|
if nhsmame then return 3;
|
|
return 2;
|
|
end
|
|
function FormatCode();
|
|
begin
|
|
ParserTslToken();
|
|
//FOR I,V IN FTokens do ECHO v.FStr,"\r\n";
|
|
//return ;
|
|
DelTokens();
|
|
ctk := CurrentTK();
|
|
state := Fstates.GetState();
|
|
while ctk do
|
|
begin
|
|
bkindex := FTkIndex;
|
|
if (state .& BT_DEF) and (ctk.FType .& TK_KEY ) and (ctk.FTypeSub .& TK_TYPE) then //type class
|
|
begin
|
|
bctk := ctk;
|
|
ctk := NextNComTk(); //name
|
|
if not ctk then
|
|
begin
|
|
AddTokenToStr(bkindex);
|
|
FTkIndex := bkindex;
|
|
ctk := NextTK();
|
|
continue;
|
|
end
|
|
ctk := NextNComTk();//=
|
|
if not(ctk) then
|
|
begin
|
|
AddTokenToStr(bkindex);
|
|
FTkIndex := bkindex;
|
|
ctk := NextTK();
|
|
continue;
|
|
end
|
|
ctk := NextNComTk();//class
|
|
if not ctk then
|
|
begin
|
|
AddTokenToStr(bkindex);
|
|
FTkIndex := bkindex;
|
|
ctk := NextTK();
|
|
continue;
|
|
end
|
|
if {lowercase(ctk.FStr)<>"class"} not( ctk.FTypeSub .& TK_CLASS) then
|
|
begin
|
|
AddTokenToStr(bkindex);
|
|
FTkIndex := bkindex;
|
|
ctk := NextTK();
|
|
continue;
|
|
end
|
|
ctk := NextNComTk(); //(
|
|
if ctk and ctk.FStr="(" then
|
|
begin
|
|
while true do
|
|
begin
|
|
ctk := NextNComTk();
|
|
if not(ctk) or ctk.FStr=")" then
|
|
begin
|
|
break;
|
|
end
|
|
end
|
|
end else
|
|
begin
|
|
PrevNComTK();
|
|
end
|
|
ChangeLine();
|
|
Formataline(bkindex,FTkIndex);
|
|
ChangeLine();
|
|
FHier.Push();
|
|
FStates.Push(BT_TYPE);
|
|
state := BT_TYPE;
|
|
end else
|
|
if (state .& BT_DEF) and (ctk.FType .& TK_KEY ) and (ctk.FTypeSub .& TK_UNIT) then //unit
|
|
begin
|
|
ctk := NextNComTk(); //name
|
|
if not(ctk) then
|
|
begin
|
|
AddTokenToStr(bkindex);
|
|
FTkIndex := bkindex;
|
|
ctk := NextTK();
|
|
continue;
|
|
end
|
|
ctk := NextNComTk();// ;
|
|
if not(ctk) or(ctk.FStr<>";") then
|
|
begin
|
|
AddTokenToStr(bkindex);
|
|
FTkIndex := bkindex;
|
|
ctk := NextTK();
|
|
continue;
|
|
end
|
|
ChangeLine();
|
|
Formataline(bkindex,FTkIndex);
|
|
ChangeLine();
|
|
// FHier.Push(); //20220606 unit 去掉缩进
|
|
FStates.Push(BT_UNIT);
|
|
state := BT_UNIT;
|
|
//return "";
|
|
end else
|
|
if {(state .& BT_BEGIN) and} (ctk.FType .& TK_KEY ) and (ctk.FTypeSub .& TK_CASE) then //case of
|
|
begin
|
|
while true do
|
|
begin
|
|
ctk := NextNComTk();
|
|
if (ctk.FType .& TK_KEY) and (ctk.FTypeSub .& TK_OF) then
|
|
begin
|
|
break;
|
|
end
|
|
end
|
|
ChangeLine();
|
|
Formataline(bkindex,FTkIndex);
|
|
ChangeLine();
|
|
FHier.Push();
|
|
state := BT_TYPE;
|
|
Fstates.Push(BT_BEGIN);
|
|
end else
|
|
if(ctk.FType .& TK_KEY) and ((ctk.FTypeSub .& TK_TRY) ) then //TRY
|
|
begin
|
|
ChangeLine();
|
|
AddTokenToStr(FTkIndex);
|
|
ChangeLine();
|
|
FHier.Push();
|
|
state := BT_TRY;
|
|
Fstates.Push(BT_TRY);
|
|
end else
|
|
if(ctk.FType .& TK_KEY) and ((ctk.FTypeSub .& TK_BEGIN) ) then //begin
|
|
begin
|
|
ChangeLine();
|
|
AddTokenToStr(FTkIndex);
|
|
ChangeLine();
|
|
FHier.Push();
|
|
state := BT_BEGIN;
|
|
Fstates.Push(BT_BEGIN);
|
|
end else
|
|
if (ctk.FType .& TK_KEY) and ((ctk.FTypeSub .& TK_END) ) then //end
|
|
begin
|
|
//select end 不换行
|
|
if state<>BT_SELECT then
|
|
begin
|
|
ChangeLine();
|
|
end
|
|
FHier.Pop();
|
|
AddTokenToStr(FTkIndex);
|
|
//select end 结尾也不换行
|
|
if state<>BT_SELECT then
|
|
begin
|
|
ChangeLine();
|
|
end
|
|
Fstates.Pop();
|
|
state := Fstates.GetState();
|
|
ChangeLine();
|
|
end else
|
|
if (ctk.FType .& TK_KEY) and (ctk.FTypeSub .& TK_SELECT) then //select
|
|
begin
|
|
AddTokenToStr(FTkIndex);
|
|
//ChangeLine();
|
|
FHier.push();
|
|
state := BT_SELECT;
|
|
Fstates.Push(BT_SELECT);
|
|
end else
|
|
{if (ctk.FType .& TK_KEY) and (ctk.FTypeSub .& TK_TRY) then//try
|
|
begin
|
|
ChangeLine();
|
|
AddTokenToStr(FTkIndex);
|
|
ChangeLine();
|
|
state := BT_TRY;
|
|
FHier.push();
|
|
Fstates.Push(BT_TRY);
|
|
end else }
|
|
if (state .& BT_TRY) and (ctk.FType .& TK_KEY) and (ctk.FTypeSub .& TK_EXCEPT) then
|
|
begin
|
|
ChangeLine();
|
|
FFormatStr+=FHier.HierStr(-1)+ ctk.FStr+"\r\n";
|
|
end else
|
|
if (ctk.FType .& TK_KEY) and ((ctk.FTypeSub .& TK_CLASS)) and (state .& BT_TYPE) then
|
|
begin
|
|
|
|
ntk := NextNComTk();
|
|
if ntk and (ntk.FTypeSub .& TK_FUNCTION ) then
|
|
begin
|
|
ChangeLine();
|
|
r := Findftokens();
|
|
if r=0 then
|
|
begin
|
|
FTkIndex := bkindex;
|
|
AddTokenToStr(bkindex);
|
|
end else
|
|
begin
|
|
ChangeLine();
|
|
Formataline(bkindex,FTkIndex);
|
|
ChangeLine();
|
|
end
|
|
end else
|
|
begin
|
|
FTkIndex := bkindex;
|
|
AddTokenToStr(bkindex);
|
|
end
|
|
end else
|
|
if (ctk.FType .& TK_KEY) and ((ctk.FTypeSub .& TK_FUNCTION)) then //function
|
|
begin
|
|
r := Findftokens();
|
|
if r=0 then
|
|
begin
|
|
FTkIndex := bkindex;
|
|
AddTokenToStr(FTkIndex);
|
|
end else
|
|
begin
|
|
if r<>3 then
|
|
ChangeLine();
|
|
Formataline(bkindex,FTkIndex);
|
|
ChangeLine();
|
|
end
|
|
end else
|
|
if (ctk.FTypeSub .& TK_ARRAY) then
|
|
begin
|
|
AddTokenToStr(FTkIndex);
|
|
state := BT_ARRAY;
|
|
end else
|
|
if (ctk.FStr ="(") then
|
|
begin
|
|
AddTokenToStr(FTkIndex);
|
|
FHier.push();
|
|
if state = BT_ARRAY then
|
|
begin
|
|
//移动到下方
|
|
ptk := GetPrevTK();
|
|
if ptk.FTypeSub .& TK_ARRAY then
|
|
begin
|
|
Fstates.Push(BT_ARRAY);
|
|
end else
|
|
if (ptk.FStr="+") or (ptk.FType .& TK_W) then //运算
|
|
begin
|
|
Fstates.Push(BT_CALC);
|
|
state := BT_CALC;
|
|
end else
|
|
begin
|
|
Fstates.Push(BT_ARRAY);
|
|
end
|
|
//移动到的新位置
|
|
if (state = BT_ARRAY)and (FArrayType .& 2) and (ptk := GetNextTK()) and ( ptk.FStr<>")") then
|
|
begin
|
|
ChangeLine();
|
|
end
|
|
end else
|
|
begin
|
|
Fstates.Push(BT_CALC);
|
|
end
|
|
end else
|
|
if ( ctk.FStr =")") then
|
|
begin
|
|
lstate := state;
|
|
ischangelined := false;
|
|
if ctk.FFirst and (state=BT_ARRAY) and (FArrayType=0) then
|
|
begin
|
|
ChangeLine();
|
|
ischangelined := true;
|
|
end
|
|
FHier.Pop();
|
|
Fstates.Pop();
|
|
if not(FArrayType .&2) then
|
|
begin
|
|
AddTokenToStr(FTkIndex);
|
|
end
|
|
state := Fstates.GetState();
|
|
if (ischangelined =false) and FArrayType and (lstate = BT_ARRAY) and (state=BT_ARRAY) then
|
|
begin
|
|
tt := GetPrevNComTK(ttid);
|
|
ttstr := tt.FStr;
|
|
if ttstr<>"(" then
|
|
begin
|
|
ChangeLine();
|
|
end
|
|
end
|
|
if (FArrayType .&2) then
|
|
begin
|
|
AddTokenToStr(FTkIndex);
|
|
end
|
|
end else
|
|
if (FArrayType .& 2 ) and (state = BT_ARRAY) and (ctk.FStr =",") then
|
|
begin
|
|
AddTokenToStr(FTkIndex);
|
|
ChangeLine();
|
|
end else
|
|
if FArrayType and (ctk.FTypeSub .& TK_ARRAY) then
|
|
begin
|
|
AddTokenToStr(FTkIndex);
|
|
state := BT_ARRAY;
|
|
end
|
|
else //普通情况
|
|
begin
|
|
AddTokenToStr(FTkIndex);
|
|
end
|
|
ctk := NextTK();
|
|
end
|
|
return FFormatStr;
|
|
end
|
|
function AddToken(sp,ep,t);
|
|
begin
|
|
if not(ep>=sp) then return;
|
|
ls := FScriptL[sp:ep];
|
|
tklen := length(FTokens);
|
|
|
|
if ls=";" then
|
|
begin
|
|
ltk := FTokens[tklen-1];
|
|
if ltk and not(ltk.FType .& TK_STR) and (ltk.FStr=";") then return ;
|
|
end
|
|
t1 := t;
|
|
stype := 0;
|
|
if t = TK_W then
|
|
begin
|
|
nchange := false;
|
|
case ls of
|
|
"*":
|
|
begin
|
|
stype := TK_DO;
|
|
end
|
|
"array": stype := TK_ARRAY;
|
|
"if":
|
|
begin
|
|
stype := TK_IF;
|
|
end
|
|
"new":
|
|
begin
|
|
stype := TK_NEW;
|
|
end
|
|
"then" :
|
|
begin
|
|
stype := TK_THEN;
|
|
end
|
|
"rdo2","rdo","do":
|
|
begin
|
|
stype := TK_DO;
|
|
end
|
|
"else" : stype := TK_ELSE;
|
|
"begin" : stype := TK_BEGIN;
|
|
"end":
|
|
begin
|
|
stype := TK_END;
|
|
end
|
|
"end.":
|
|
begin
|
|
stype := TK_END;
|
|
end
|
|
"class":
|
|
begin
|
|
stype := TK_CLASS;
|
|
end
|
|
"unit":
|
|
begin
|
|
stype := TK_UNIT;
|
|
end
|
|
{$ifdef weakref}
|
|
"private","public","published","interface","implementation","initialization","weakref","autoref" : stype := TK_PRIVATE;
|
|
{$else}
|
|
"private","public","published","interface","implementation","initialization": stype := TK_PRIVATE;
|
|
{$endif}
|
|
"function","procedure": stype := TK_FUNCTION;
|
|
"type": stype := TK_TYPE;
|
|
"try": stype := TK_TRY;
|
|
"except","finally": stype := TK_EXCEPT;
|
|
"case" : stype := TK_CASE;
|
|
"of" : stype := TK_OF;
|
|
"select","mselect","vselect","sselect","update":
|
|
begin
|
|
stype := TK_SELECT;
|
|
end
|
|
"external": stype := TK_EXTERNAL;
|
|
"cdecl": stype := TK_CDECL;
|
|
"name": stype := TK_NAME;
|
|
"stdcall":stype := TK_STDCALL;
|
|
else
|
|
begin
|
|
nchange := true;
|
|
end
|
|
end ;
|
|
if not nchange then t1 := TK_KEY;
|
|
end
|
|
TK := new TTK(FScript[sp:ep],t1,stype);
|
|
TK.FFirst := FAtRowFirst;
|
|
tk.FStrL := ep-sp+1;
|
|
//tk.FLstr := ls;
|
|
FTokens[tklen] := tk;//array("type":t,"str":FScript[sp:ep],"subtype":stype);
|
|
FAtRowFirst := 0;
|
|
end
|
|
function iswordchar(s,idx);
|
|
begin
|
|
if idx<1 then return 0;//第一个
|
|
cchar := s[idx];
|
|
occhar := ord(cchar);
|
|
if 0= bytetype(s,idx) then //ascii
|
|
begin
|
|
return (occhar>=46 and occhar<=57 ) or //数字
|
|
(occhar>=65 and occhar<=90) or //大字母
|
|
(occhar>=97 and occhar<=122) //小字母
|
|
end
|
|
//汉字
|
|
return 1;
|
|
|
|
end
|
|
function ParserTslToken();
|
|
begin
|
|
FTokens := array();
|
|
FAtRowFirst := true;
|
|
if not ifstring(FScript) then return ;
|
|
strl := length(FScriptL);
|
|
cwrd := "";
|
|
cwrdstart:=1;
|
|
idx := 1;
|
|
while idx<=strl do
|
|
begin
|
|
if FSynParser.Find(FScriptL,strl,idx,outidx,outstr) then
|
|
begin
|
|
inidx := idx;
|
|
idx := outidx;
|
|
AddToken(cwrdstart,inidx-1,TK_W);
|
|
cwrdstart := outidx;
|
|
case outstr of
|
|
"0x": //16进制
|
|
begin
|
|
idx2 := idx;
|
|
while idx2<=strl do
|
|
begin
|
|
cchar := FScriptL[idx2];
|
|
if cchar in array("0","1","2","3","4","5","6","7","8","9","a","b","c","d","e","f") then
|
|
begin
|
|
|
|
end else
|
|
if cchar="l" then
|
|
begin
|
|
idx := idx2+1;
|
|
break;
|
|
end else
|
|
begin
|
|
idx := idx2;
|
|
break;
|
|
end
|
|
idx2++;
|
|
end
|
|
if idx2>strl then
|
|
begin
|
|
idx := idx2;
|
|
return AddToken(inidx,idx-1,TK_W);
|
|
end else
|
|
begin
|
|
AddToken(inidx,idx-1,TK_W);
|
|
end
|
|
end
|
|
"0o": //8进制
|
|
begin
|
|
idx2 := idx;
|
|
while idx2<=strl do
|
|
begin
|
|
cchar := FScriptL[idx2];
|
|
if cchar in array("0","1","2","3","4","5","6","7") then
|
|
begin
|
|
|
|
end else
|
|
if cchar="l" then
|
|
begin
|
|
idx := idx2+1;
|
|
break;
|
|
end else
|
|
begin
|
|
idx := idx2;
|
|
break;
|
|
end
|
|
idx2++;
|
|
end
|
|
if idx2>strl then
|
|
begin
|
|
idx := idx2;
|
|
return AddToken(inidx,idx-1,TK_W);
|
|
end else
|
|
begin
|
|
AddToken(inidx,idx-1,TK_W);
|
|
end
|
|
end
|
|
"0b": //2进制
|
|
begin
|
|
idx2 := idx;
|
|
while idx2<=strl do
|
|
begin
|
|
cchar := FScriptL[idx2];
|
|
if cchar in array("0","1") then
|
|
begin
|
|
|
|
end else
|
|
if cchar="l" then
|
|
begin
|
|
idx := idx2+1;
|
|
break;
|
|
end else
|
|
begin
|
|
idx := idx2;
|
|
break;
|
|
end
|
|
idx2++;
|
|
end
|
|
if idx2>strl then
|
|
begin
|
|
idx := idx2;
|
|
return AddToken(inidx,idx-1,TK_W);
|
|
end else
|
|
begin
|
|
AddToken(inidx,idx-1,TK_W);
|
|
end
|
|
end
|
|
"%%":
|
|
begin
|
|
idx2 := idx;
|
|
while idx2<=strl do
|
|
begin
|
|
cchar := FScriptL[idx2];
|
|
if pos(cchar," \r\n\t") then
|
|
begin
|
|
if FindStrInStr(FScriptL,strl,FScriptL[inidx:idx2-1],idx2,outidx,outstr) then
|
|
begin
|
|
idx := outidx;
|
|
AddToken(inidx,idx-1,TK_STR);
|
|
end else
|
|
begin
|
|
return AddToken(inidx,strl,TK_STR);
|
|
end
|
|
break;
|
|
end
|
|
idx2++;
|
|
end
|
|
end
|
|
"l'":
|
|
begin
|
|
idx2 := idx;
|
|
while idx2<=strl do
|
|
begin
|
|
tcchar := FScriptL[idx2];
|
|
if tcchar="\\" then idx2++;
|
|
else
|
|
if tcchar="'" then
|
|
begin
|
|
AddToken(inidx,idx2,TK_STR);
|
|
idx := idx2+1;
|
|
cwrdstart := idx+1;
|
|
break;
|
|
end
|
|
idx2++;
|
|
end
|
|
IF idx2>strl then
|
|
begin
|
|
return AddToken(inidx,strl,TK_STR);;
|
|
end
|
|
end
|
|
'l"':
|
|
begin
|
|
idx2 := idx;
|
|
while idx2<=strl do
|
|
begin
|
|
tcchar := FScriptL[idx2];
|
|
if tcchar="\\" then idx2++;
|
|
else
|
|
if tcchar='"' then
|
|
begin
|
|
AddToken(inidx,idx2,TK_STR);
|
|
idx := idx2+1;
|
|
cwrdstart := idx+1;
|
|
break;
|
|
end
|
|
idx2++;
|
|
end
|
|
IF idx2>strl then
|
|
begin
|
|
return AddToken(inidx,strl,TK_STR);;
|
|
end
|
|
end
|
|
"//","#!":
|
|
begin
|
|
idx2 := idx ;
|
|
while idx2<=strl do
|
|
begin
|
|
cchar := FScriptL[idx2];
|
|
if cchar="\r" or cchar = "\n" then
|
|
begin
|
|
idx := idx2+1;
|
|
AddToken(inidx,idx2-1,TK_C .| TK_C_S);
|
|
|
|
FAtRowFirst := true;
|
|
break;
|
|
end
|
|
idx2++;
|
|
end
|
|
if idx2>strl then
|
|
begin
|
|
return AddToken(inidx,strl,TK_C .| TK_C_S);
|
|
end
|
|
end
|
|
"(*":
|
|
begin
|
|
idx2 := idx;
|
|
if FindStrInStr(FScriptL,strl,"*)",idx2,outidx,outstr) then
|
|
begin
|
|
idx := outidx;
|
|
AddToken(inidx,idx-1,TK_C .| TK_C_D2);
|
|
end else
|
|
begin
|
|
return AddToken(inidx,strl,TK_C .| TK_C_D2);
|
|
end
|
|
end
|
|
"<?tslx>","?>":
|
|
begin
|
|
idx2 := idx;
|
|
if FindStrInStr(FScriptL,strl,"<?tsl",idx2,outidx,outstr) then
|
|
begin
|
|
idx := outidx;
|
|
//AddToken(inidx,idx-1,TK_TSLX);
|
|
AddToken(inidx,idx-1,TK_W); //暂时修改
|
|
end else
|
|
begin
|
|
return AddToken(inidx,strl,TK_TSLX);
|
|
end
|
|
end
|
|
"++","--":
|
|
begin
|
|
AddToken(inidx,outidx-1,TK_SYN);
|
|
end
|
|
"*","//":
|
|
begin
|
|
AddToken(inidx,outidx-1,TK_SYN .| TK_SYN_S);
|
|
end else
|
|
begin
|
|
AddToken(inidx,outidx-1,{TK_SYN .| TK_SYN_S}TK_W);
|
|
|
|
end
|
|
end ;
|
|
cwrdstart := idx;
|
|
continue;
|
|
end
|
|
if (not iswordchar(FScriptL,idx-1)) and FSynParser2.Find(FScriptL,strl,idx,outidx,outstr) then //处理前面是正常字母的运算符
|
|
begin
|
|
inidx := idx;
|
|
idx := outidx;
|
|
AddToken(cwrdstart,inidx-1,TK_W);
|
|
cwrdstart := outidx;
|
|
AddToken(inidx,outidx-1,TK_SYN .| TK_SYN_S);
|
|
cwrdstart := idx;
|
|
continue;
|
|
end
|
|
cchar := FScriptL[idx];
|
|
{if cchar in array("0","1","2","3","4","5","6","7","8","9") then
|
|
begin
|
|
st := 0; //0 数字 1 小数部分 2 科学计数法 3 科学计数法小数部分
|
|
idx2 := idx+1;
|
|
while idx2 <=strl do
|
|
begin
|
|
tcchar := FScriptL[idx2];
|
|
if tcchar in array("0","1","2","3","4","5","6","7","8","9") then
|
|
begin
|
|
|
|
end else
|
|
if tcchar="l" and st=0 then //数字结束
|
|
begin
|
|
idx := idx2+1;
|
|
break;
|
|
end else
|
|
if st<2 and tcchar="e" then
|
|
begin
|
|
st :=3;
|
|
if idx2<strl and (FScriptL[idx2+1] in array("-","+")) then
|
|
begin
|
|
idx2++;
|
|
end
|
|
end else
|
|
if st=0 and tcchar="." then
|
|
begin
|
|
st:=1;
|
|
end else
|
|
if st=3 and tcchar="." then
|
|
begin
|
|
st :=4
|
|
end else
|
|
begin
|
|
idx := idx2;
|
|
break;
|
|
end
|
|
idx2++;
|
|
end
|
|
|
|
if idx2>strl then
|
|
begin
|
|
idx := idx2;
|
|
return AddToken(inidx,idx-1,TK_W);
|
|
end else
|
|
begin
|
|
echo
|
|
AddToken(inidx,idx-1,TK_W);
|
|
end
|
|
|
|
end else }
|
|
if cchar="{" then
|
|
begin
|
|
AddToken(cwrdstart,idx-1,TK_W);
|
|
cwrdstart:= idx;
|
|
idx2 := idx+1;
|
|
while idx2<=strl do
|
|
begin
|
|
tcchar := FScriptL[idx2];
|
|
if tcchar="}" then
|
|
begin
|
|
AddToken(idx,idx2,TK_C .| TK_C_D1);
|
|
idx := idx2;
|
|
cwrdstart := idx2+1;
|
|
break;
|
|
end
|
|
idx2++;
|
|
end
|
|
if idx2>strl then
|
|
begin
|
|
return AddToken(inidx,strl,TK_C .| TK_C_D1);
|
|
end
|
|
end else
|
|
if cchar="'" then
|
|
begin
|
|
AddToken(cwrdstart,idx-1,TK_W);
|
|
idx2 := idx+1;
|
|
while idx2<=strl do
|
|
begin
|
|
tcchar := FScriptL[idx2];
|
|
if tcchar="\\" then idx2++;
|
|
else
|
|
if tcchar="'" then
|
|
begin
|
|
AddToken(idx,idx2,TK_STR);
|
|
idx := idx2;
|
|
cwrdstart := idx+1;
|
|
break;
|
|
end
|
|
idx2++;
|
|
end
|
|
IF idx2>strl then
|
|
begin
|
|
return AddToken(idx,strl,TK_STR);;
|
|
end
|
|
end else
|
|
if cchar='"' then
|
|
begin
|
|
AddToken(cwrdstart,idx-1,TK_W);
|
|
cwrdstart := idx+1;
|
|
idx2 := idx+1;
|
|
while idx2<=strl do
|
|
begin
|
|
tcchar := FScriptL[idx2];
|
|
if tcchar="\\" then idx2++;
|
|
else
|
|
if tcchar='"' then
|
|
begin
|
|
AddToken(idx,idx2,TK_STR);
|
|
idx := idx2;
|
|
cwrdstart := idx+1;
|
|
break;
|
|
end
|
|
idx2++;
|
|
end
|
|
IF idx2>strl then
|
|
begin
|
|
return AddToken(idx,strl,TK_STR);;
|
|
end
|
|
end else
|
|
if cchar="\n" then
|
|
begin
|
|
AddToken(cwrdstart,idx-1,TK_W);
|
|
cwrdstart := idx+1;
|
|
FAtRowFirst := true;
|
|
end else
|
|
if pos(cchar," \r\t") then //间隔符号
|
|
begin
|
|
AddToken(cwrdstart,idx-1,TK_W);
|
|
cwrdstart := idx+1;
|
|
end else
|
|
if pos(cchar,"()[]") then
|
|
begin
|
|
AddToken(cwrdstart,idx-1,TK_W);
|
|
AddToken(idx,idx,TK_SYN);
|
|
cwrdstart := idx+1;
|
|
end else
|
|
if cchar=";" then
|
|
begin
|
|
AddToken(cwrdstart,idx-1,TK_W);
|
|
AddToken(idx,idx,TK_SYN);
|
|
cwrdstart := idx+1;
|
|
//分割符
|
|
end else
|
|
if cchar="," then
|
|
begin
|
|
AddToken(cwrdstart,idx-1,TK_W);
|
|
cwrdstart := idx+1;
|
|
AddToken(idx,idx,TK_SYN);
|
|
end else
|
|
if pos(cchar,"*=+-*/\\`~!@#$%^&*?><.:") then
|
|
begin
|
|
AddToken(cwrdstart,idx-1,TK_W);
|
|
cwrdstart := idx+1;
|
|
AddToken(idx,idx,TK_SYN);
|
|
end
|
|
idx++;
|
|
end
|
|
AddToken(cwrdstart,strl,TK_W);
|
|
end
|
|
published
|
|
property AlignBlockComment read FAlignBlockComment write FAlignBlockComment;
|
|
Property Tokens read FTokens;
|
|
property Script read FScript write SetScript;
|
|
property HierarchyWidth read FHierarchyWidth write FHierarchyWidth;
|
|
property MaxLineCount Read FMaxLineCount write FMaxLineCount;
|
|
property MaxLineLength read FMaxLineLength write FMaxLineLength;
|
|
property ArrayType read FArrayType write SetArrayType;
|
|
private
|
|
function FindStrInStr(s,slen,fs,idx,outidx,outstr);
|
|
begin
|
|
tfinder := new TTire();
|
|
tfinder.Add(fs);
|
|
tidx := idx;
|
|
while tidx<=slen do
|
|
begin
|
|
if tfinder.Find(s,slen,tidx,outidx,outstr) then
|
|
begin
|
|
return true;
|
|
end
|
|
tidx++;
|
|
end
|
|
return false;
|
|
end
|
|
function SetScript(s);
|
|
begin
|
|
if s<>FScript then
|
|
begin
|
|
FScriptL := "";
|
|
FScript := "";
|
|
FTokens := array();
|
|
if ifstring(s) then
|
|
begin
|
|
FScript := s;
|
|
FScriptL := lowercase(s);
|
|
end
|
|
end
|
|
end
|
|
function Setarraytype(t);
|
|
begin
|
|
if FArrayType=t then return ;
|
|
if t in array(0,1,2,3) then
|
|
begin
|
|
FArrayType := t;
|
|
end
|
|
end
|
|
private
|
|
FAlignBlockComment;
|
|
FAtRowFirst;
|
|
FArrayType;
|
|
FTokens;
|
|
FHierarchyWidth;
|
|
FSym;
|
|
FScript;
|
|
FScriptL;
|
|
end
|
|
Type TTK = class
|
|
FType;
|
|
FTypeSub;
|
|
FStr;
|
|
FLstr;
|
|
FStrL;
|
|
FFirst;
|
|
function Create(s,t,st);
|
|
begin
|
|
FStr := s;
|
|
FType := t;
|
|
FTypeSub := st ;
|
|
end
|
|
end
|
|
|
|
Type TStateStack = class
|
|
function Create();
|
|
begin
|
|
FStates := array();
|
|
FIndex := -1;
|
|
end
|
|
function GetState();
|
|
begin
|
|
if FIndex>=0 then
|
|
begin
|
|
return FStates[FIndex];
|
|
end
|
|
return 1;
|
|
end
|
|
function Push(s);
|
|
begin
|
|
if s>0 then
|
|
begin
|
|
FIndex++;
|
|
FStates[FIndex] := s;
|
|
end
|
|
end
|
|
function Pop();
|
|
begin
|
|
if FIndex>=0 then
|
|
begin
|
|
r := FStates[FIndex];
|
|
FIndex--;
|
|
return r;
|
|
end
|
|
return 0;
|
|
end
|
|
private
|
|
FStates;
|
|
FIndex;
|
|
end
|
|
TYPE THStack = class
|
|
function Create(w);
|
|
begin
|
|
FLength := 0;
|
|
FHierarchyWidth := w;
|
|
FCache := array();
|
|
end
|
|
function Push();
|
|
begin
|
|
FLength++;
|
|
end
|
|
function Pop();
|
|
begin
|
|
r := FLength;
|
|
if FLength>0 then FLength--;
|
|
return r;
|
|
end
|
|
function HierStr(es);
|
|
begin
|
|
if not(es>0 or es<0) then es := 0;
|
|
cct := (FLength+es)*FHierarchyWidth;
|
|
r := FCache[cct];
|
|
if r then return r;
|
|
r := "";
|
|
for i:=1 to cct do
|
|
begin
|
|
r+=" ";
|
|
end
|
|
FCache[cct] := r;
|
|
return r;
|
|
end
|
|
property Hier read FLength;
|
|
FHierarchyWidth;
|
|
FLength;
|
|
FVS;
|
|
FCache;
|
|
|
|
end
|
|
|
|
end.
|
|
{else
|
|
if FArrayType and (ctk.FStr ="(") then
|
|
begin
|
|
AddTokenToStr(FTkIndex);
|
|
FHier.push();
|
|
if state = BT_ARRAY then
|
|
begin
|
|
//移动到下方
|
|
ptk := GetPrevTK();
|
|
if ptk.FTypeSub .& TK_ARRAY then
|
|
begin
|
|
Fstates.Push(BT_ARRAY);
|
|
end else
|
|
if (ptk.FStr="+") or (ptk.FType .& TK_W) then //运算
|
|
begin
|
|
Fstates.Push(BT_CALC);
|
|
state := BT_CALC;
|
|
end else
|
|
begin
|
|
Fstates.Push(BT_ARRAY);
|
|
end
|
|
//移动到的新位置
|
|
if (state = BT_ARRAY)and (FArrayType .& 2) and (ptk := GetNextTK()) and ( ptk.FStr<>")") then
|
|
begin
|
|
ChangeLine();
|
|
end
|
|
end else
|
|
begin
|
|
Fstates.Push(BT_CALC);
|
|
end
|
|
end else
|
|
if FArrayType and ( ctk.FStr =")") then
|
|
begin
|
|
lstate := state;
|
|
FHier.Pop();
|
|
Fstates.Pop();
|
|
AddTokenToStr(FTkIndex);
|
|
state := Fstates.GetState();
|
|
if (lstate = BT_ARRAY) and (state=BT_ARRAY) then
|
|
begin
|
|
tt := GetPrevNComTK(ttid);
|
|
ttstr := tt.FStr;
|
|
if ttstr<>"(" then
|
|
begin
|
|
ChangeLine();
|
|
end
|
|
end
|
|
end } |