设计器

升级语法解析

designer/utslcodeeditor.tsf

@@ -1235,6 +1235,29 @@ type TPageEditerItem=class(TPageItem)
                     FEditer.ExecuteCommand(FEditer.ecSelGotoXY,frec[1]);
                     FEditer.SelText := nn?(nn+";"):"";
                 end
+                wek := v["dstatic"];
+                if wek then 
+                begin
+                    frec := GetInfoRowCol2(wek);
+                    if ifarray(frec[0])and ifarray(frec[1])then
+                    begin
+                        FEditer.ExecuteCommand(FEditer.ecGotoXY,frec[0]);
+                        FEditer.ExecuteCommand(FEditer.ecSelGotoXY,frec[1]);
+                        FEditer.SelText := nn?(nn+";"):"";
+                    end
+                end 
+                wek := v["weakref"];
+                if wek then 
+                begin
+                    frec := GetInfoRowCol2(wek);
+                    if ifarray(frec[0])and ifarray(frec[1])then
+                    begin
+                        FEditer.ExecuteCommand(FEditer.ecGotoXY,frec[0]);
+                        FEditer.ExecuteCommand(FEditer.ecSelGotoXY,frec[1]);
+                        FEditer.SelText := nn?(nn+";"):"";
+                    end
+                end 
+                
             end
         end
     end
@@ -1972,6 +1995,13 @@ type TEditer=class(TCustomcontrol) //
         FIsFinding := true;
         if not(d["c_reg"])then
         begin
+            if(d["section"]="查找")and(d["btn"]="计数")then
+            begin
+                ct := "noshow";
+                FindAllInCurrent(d,o,nil,ct);
+                o.SetStatusText(format("查找到 %d处",ct));
+                return EndFind();    
+            end else 
             if(d["section"]="查找")and(d["btn"]="全部查找")then
             begin
                 FFindListWnd.Clean();
@@ -3598,7 +3628,7 @@ type TEditer=class(TCustomcontrol) //
                 L := ed.CaretY;
                 if cidx=L then continue;
                 cidx := L;
-                scap := format("    %d:(第%d行) ",idx,L)+trim(ed.LineText);
+                scap := format("    %d:(第%d行) ",idx,L)+limitstringlength(ed.LineText);
                 FFindListWnd.AppendItem(array("caption":scap,"file":it.OrigScriptPath,"line":L));
             end
         finally
@@ -3721,13 +3751,13 @@ type TEditer=class(TCustomcontrol) //
             end
             s := L.GetStringByIndex(ridx);
             ls := length(s);
+            if data["c_case"] then s := lowercase(s);
             while cx+lfs-1 <= ls do
             begin
                 if not FIsFinding then return-2;
                 //GetAndDispatchMessageA();
                 TryDispatch();
                 subs := s[cx:cx+lfs-1];
-                if data["c_case"]then subs := lowercase(subs);
                 if subs=fs and(wordwrap?((stringiswrapword=3)or(((stringiswrapword .& 1)or IsWordsChar(s,cx-1,ls))and((stringiswrapword .& 2)or IsWordsChar(s,cx+lfs,ls)))):true)then //找到了 
                 begin
                     ed.ExecuteCommand(ed.ecGotoXY,array(ridx+1,cx));
@@ -3745,7 +3775,7 @@ type TEditer=class(TCustomcontrol) //
             cx := 1;
         end
         fo.SetStatusText("到达底部");
-        return-2;
+        return -2;
     end
     function FindListChoosed(o,e);
     begin
@@ -3772,6 +3802,7 @@ type TEditer=class(TCustomcontrol) //
     end
     function FindAllInCurrent(data,fo,it,rt);
     begin
+        if rt = "noshow" then fnoshow := true;
         rt := 0;
         if not it then it := GetCurrentItem();
         if not it then return;
@@ -3785,29 +3816,33 @@ type TEditer=class(TCustomcontrol) //
         lfs := length(fs);
         L := ed.Lines;
         ct := L.length();
-        cidx := 0;
+        
         for i := 0 to ct-1 do
         begin
             s := L.GetStringByIndex(i);
             ls := length(s);
             cx := 1;
+            if data["c_case"] then s := lowercase(s);
+            cidx := 0;
             while cx+lfs-1 <= ls do
             begin
                 if not FIsFinding then return rt;
                 //GetAndDispatchMessageA();
                 TryDispatch();
                 subs := s[cx:cx+lfs-1];
-                if data["c_case"]then subs := lowercase(subs);
                 //((stringiswrapword .& 2) and (IsWordsChar(s,cx-1,ls)) ( (stringiswrapword .& 1) and IsWordsChar(s,cx+lfs,ls)) )
                 if subs=fs and(wordwrap?((stringiswrapword=3)or(((stringiswrapword .& 1)or IsWordsChar(s,cx-1,ls))and((stringiswrapword .& 2)or IsWordsChar(s,cx+lfs,ls)))):true)then //找到了 
                 begin
-                    if rt=0 then FFindListWnd.AppendItem(array("caption":format("find:%s in file:%s",fs,it.OrigScriptPath),"file":it.OrigScriptPath,"line":1));
+                    if rt=0 and (not fnoshow) then FFindListWnd.AppendItem(array("caption":format("find:%s in file:%s",fs,it.OrigScriptPath),"file":it.OrigScriptPath,"line":1));
                     cx += lfs;
                     rt++;
-                    if cidx=i+1 then continue;
+                    if cidx then continue;
-                    cidx := i+1;
+                    cidx := 1;
-                    scap := format("    %d:(第%d行) ",rt,i+1)+trim(s);
+                    if not fnoshow then 
-                    FFindListWnd.AppendItem(array("caption":scap,"file":it.OrigScriptPath,"line":i+1));
+                    begin 
+                        scap := format("    %d:(第%d行) ",rt,i+1)+limitstringlength(s);
+                        FFindListWnd.AppendItem(array("caption":scap,"file":it.OrigScriptPath,"line":i+1));
+                    end 
                     continue;
                 end
                 //没找到 
@@ -4603,13 +4638,21 @@ type TEditerEchoWnd=class(TSynMemoNorm) //
         FProcess.OnEcho := thisfunction(TEchoToString);
         FProcess.onended := thisfunction(onprocend);
         FProcess.onstarted := thisfunction(onprocstart);        
-        AppendString("ctrl+z 停止;ctrl+c 复制选择\r\n");
+        AppendString("ctrl+z 停止 ; ctrl+c 复制选择\r\n");
-        F_Highlighter := new TSynHighLighter(self);
+        F_Highlighter := new tcustomsynhighlighter(self);
-        //Highlighter := new TSynHighLighter(self);
+        hg := F_Highlighter;
+        hg.ExecuteCommand("strings",array());
+        hg.ExecuteCommand("keywords",array("ctrl+z","ctrl+c","echo","执行结束","开始执行"));
+        hg.ExecuteCommand("blockannotes",array());
+        hg.ExecuteCommand("rowannotes",array());
+        //hg.ExecuteCommand("regs",array("^(V|v)\\d":0x00ff00));
+        hg.ExecuteCommand("syms",array(":",";"));
+        hg.ExecuteCommand("pairs",array(("开始执行","执行结束")));
+        self.HighLighter := hg;
     end
     function onprocstart(o,e);
     begin
-        AppendString("开始执行");
+        AppendString("开始执行 ");
     end 
     function onprocend(o,e);
     begin
@@ -5010,19 +5053,24 @@ type TFindWnd=class(TPage)
         FBtn_Find := new TFindBtn(self);
         FBtn_replace := new TFindBtn(self);
         FBtn_Count := new TFindBtn(self); // 计数
+        FBtn_Count_a := new TFindBtn(self); // 计数
         FBtn_replaceall := new TFindBtn(self);
         FBtn_Find.caption := "查找";
         FBtn_replace.caption := "替换";
+        FBtn_Count_a.Caption := "计数";
         FBtn_Count.caption := "全部查找";
         FBtn_replaceall.caption := "全部替换";
         FBtn_Find.top := lg;
         FBtn_Find.parent := self;
         FBtn_replace.top := lg+lg;
+        FBtn_Count_a.top := lg+lg;
         FBtn_replace.parent := self;
+        FBtn_Count_a.parent := self;
         FBtn_replaceall.top := lg+lg+lg;
         FBtn_replaceall.parent := self;
         FBtn_Find.OnClick := thisfunction(FindBtnClick);
         FBtn_replace.OnClick := thisfunction(FindBtnClick);
+        FBtn_Count_a.OnClick := thisfunction(FindBtnClick);
         FBtn_Count.OnClick := thisfunction(FindBtnClick);
         FBtn_replaceall.OnClick := thisfunction(FindBtnClick);
         FBtn_Count.top := lg+lg+lg+lg;
@@ -5172,6 +5220,7 @@ type TFindWnd=class(TPage)
                 FEdit_dir_btn.visible := false;
                 FEdit_type.visible := false;
                 FEdit_repace.visible := false;
+                FBtn_Count_a.visible := true;
                 FBtn_replace.visible := false;
                 FBtn_count.Visible := true;
                 FBtn_Replaceall.Visible := false;
@@ -5183,6 +5232,7 @@ type TFindWnd=class(TPage)
             begin
                 flabels[1].Visible := true;
                 for i := 2 to 3 do flabels[i].Visible := false;
+                FBtn_Count_a.visible := false;
                 FEdit_dir.visible := false;
                 FEdit_dir_btn.visible := false;
                 FEdit_type.visible := false;
@@ -5197,6 +5247,7 @@ type TFindWnd=class(TPage)
             "文件查找":
             begin
                 for i := 1 to 3 do flabels[i].Visible := true;
+                FBtn_Count_a.visible := false;
                 FEdit_dir.visible := true;
                 FEdit_dir_btn.Visible := true;
                 FEdit_type.visible := true;
@@ -5257,6 +5308,7 @@ type TFindWnd=class(TPage)
         end
     end
     private
+    weakref
     FStatus;
     FDirChooser;
     //查找
@@ -5267,6 +5319,7 @@ type TFindWnd=class(TPage)
     FEdit_dir_btn;
     FBtn_Find;
     FBtn_replace;
+    FBtn_Count_a;
     FBtn_Replaceall;
     FBtn_Count; // 计数
     flabels;
@@ -5277,6 +5330,7 @@ type TFindWnd=class(TPage)
     FCheck_reg;
     FCheck_subdir;
     FCheck_gt;
+    autoref
 end
 
 type TGoToLineWnd=class(TVCForm) //跳转
@@ -5469,6 +5523,22 @@ function gettslexe();
 begin
     return static gettslexefullpath();
 end   
+function limitstringlength(s);
+begin
+    len := length(s); 
+    n := 150;
+    if len>n then 
+    begin
+        if bytetype(s,n)=1 then 
+        begin
+            return trim(s[1:(n-1)])+"...";
+        end else 
+        begin
+            return trim(s[1:n])+"...";
+        end 
+    end 
+    return trim(s);
+end 
 {$ifdef linux}
 function HtmlHelpA()
 begin

designer/utslsynmemo.tsf

@@ -1379,7 +1379,7 @@ type TJsonSynHighLighter = class(tcustomsynhighlighter)
     function create(AOwner);
     begin
         inherited;
-        ExecuteCommand("string",array(('"',"\\"),("'","\\")));
+        ExecuteCommand("strings",array(('"',"\\"),("'","\\")));
         ExecuteCommand("keywords",array("null","true","false"));
         ExecuteCommand("rowannotes",array());
         ExecuteCommand("blockannotes",array());
@@ -1395,7 +1395,7 @@ type TJsSynHighLighter = class(tcustomsynhighlighter)
         keywordcolor := 0xff0000;
         stringcolor := 0x968080;
         annotationcolor := 0x8D9600;
-        ExecuteCommand("string",array(('"',"\\")));
+        ExecuteCommand("strings",array(('"',"\\")));
         ExecuteCommand("keywords",jskeywords1());        
         ExecuteCommand("rowannotes",array("//"));
         ExecuteCommand("blockannotes",array(("/*","*/")));
@@ -1421,7 +1421,7 @@ type TcssSynHighLighter = class(tcustomsynhighlighter)
         keywordcolor := 0xff0000;
         stringcolor := 0x968080;
         annotationcolor := 0x8D9600;
-        ExecuteCommand("string",array(('"',"\\")));
+        ExecuteCommand("strings",array(('"',"\\")));
         ExecuteCommand("keywords",getcsswords());        
         ExecuteCommand("rowannotes",array());
         ExecuteCommand("blockannotes",array(("/*","*/")));
@@ -1436,7 +1436,7 @@ type ttfmhighlighter = class(tcustomsynhighlighter)
     function create(AOwner);
     begin
         inherited;
-        ExecuteCommand("string",array(('"',"\\")));
+        ExecuteCommand("strings",array(('"',"\\")));
         ExecuteCommand("keywords",array("object","end","inherited"));
         ExecuteCommand("rowannotes",array());
         ExecuteCommand("blockannotes",array(("{","}")));

designer/utslvclsyntaxparser.tsf

@@ -217,6 +217,26 @@ type tslparser = class(tslparserbase) //
                     priv := tk;
                     continue;
                 end
+                if tk in array("weakref","autoref") then 
+                begin
+                    continue;
+                end 
+                if tk="[" and tp=TT_SYM then 
+                begin
+                    wkps := pos;
+                    while true do 
+                    begin
+                        ctoken(tk,tp,pos,row);
+                        if ifnil(tk) then break; 
+                        if tk="]" and tp=TT_SYM then 
+                        begin
+                            weakflag := array("beg":wkps,"end":pos);
+                            break;   
+                        end                                                 
+                    end 
+                    if ifnil(tk) then break;
+                    if tk="]" then continue;
+                end 
                 if tk="uses" and tp=TT_IDE then
                 begin
                     usb := pos;
@@ -235,13 +255,28 @@ type tslparser = class(tslparserbase) //
                 if tk="static" and tp=TT_IDE then
                 begin
                     if not r["filed"]then r["filed"]:= array();
+                    staticflag := array("beg":pos);
                     sf := parserfiled();
                     for i := 0 to length(sf)-1 do
                     begin
+                        if i=0 then 
+                        begin
+                            staticflag["end"] := sf[i]["beg"]-1;    
+                        end 
                         sf[i]["static"]:= true;
                         sf[i]["staticpos"]:= pos;
                         sf[i]["priv"]:= priv;
                     end
+                    if (length(sf)=1) then 
+                    begin
+                        sf[0]["dstatic"] := staticflag;
+                    end 
+                    if weakflag and (length(sf)=1) then 
+                    begin
+                        sf[0]["weakref"] := weakflag;
+                        
+                        weakflag := nil;
+                    end 
                     filed union=sf;
                 end else
                 if tk="function" or tk="procedure" then
@@ -281,7 +316,13 @@ type tslparser = class(tslparserbase) //
                 else
                 begin
                     bpos();
-                    filed union=parserfiled(priv);
+                    sf:=parserfiled(priv);
+                    if weakflag and (length(sf)=1) then 
+                    begin
+                        sf[0]["weakref"] := weakflag;
+                        weakflag := nil;
+                    end 
+                    filed union= sf;
                 end
             end
         end
@@ -326,9 +367,18 @@ type tslparser = class(tslparserbase) //
                 if rcount then
                 begin
                     r[rcount]["last"]:= true;
-                end
+                    r[rcount]["beg"] := r[rcount]["precomma"];
-                r[rcount]["end"]:= pos;
+                    if not (r[rcount]["end"]>0) then 
-                return r;
+                    begin
+                        r[rcount]["end"] := pos-1;
+                    end 
+                    
+                end else 
+                begin 
+                    r[rcount]["end"]:= pos;
+                end 
+                break;
+                // return r;
             end else
             if tk="," then
             begin
@@ -336,12 +386,20 @@ type tslparser = class(tslparserbase) //
                 begin
                     r[rcount]["nextcomma"]:= pos;
                 end else
-                r[rcount]["first"]:= true;
+                begin
+                    r[rcount]["first"]:= true;                    
+                end 
+                r[rcount]["end"] := pos;
                 rcount++;
                 r[rcount]["precomma"]:= pos;
+                
             end else
             if tk=":" then
             begin
+                if  rcount>0 then
+                begin
+                    r[rcount]["end"] := pos-1;    
+                end 
                 tpv := parsertype();
                 for i := 0 to length(r)-1 do
                 begin
@@ -360,7 +418,8 @@ type tslparser = class(tslparserbase) //
                         begin
                             r[i]["type"]:= "array";
                         end
-                        return r;
+                        break;
+                        // return r;
                     end else
                     if tk="of" then
                     begin
@@ -376,6 +435,7 @@ type tslparser = class(tslparserbase) //
                 r[rcount]["priv"]:= priv;
             end
         end
+        len := length(r);
         return r;
     end
     function parserproperty();
@@ -516,7 +576,7 @@ type tslparserbase= class            //
         begin
             TT_IDE := "±êʾ·û";
             TT_STR := "×Ö·û´®";
-            TT_SYM := "分割符";
+            TT_SYM := "·Ö¸î";
             TT_OK := true;
         end
     end

funcext/tvclib/tcontrol.tsf

@@ -522,9 +522,10 @@ type tcontrol = class(tcomponent)
         begin
             if idx=-1 then
             begin
-                FControls.append(actrl);
+                wkactl := makeweakref(actrl);
+                FControls.append(wkactl);
                 actrl.FParent := self(true);
-                ControlAppended(actrl);
+                ControlAppended(wkactl);
                 ifop := true;
             end
         end

funcext/tvclib/utslmemo.tsf

@@ -770,6 +770,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
             rc[0]:= Max(rc[0],FGutter.Width);
             //echo tostn(array(FirstLine, LastLine, FirstCol, LastCol));
             cvs := Canvas;
+            cvs.Font := font;
             bcvs := new TCanvsRgnClipAutoSave(cvs,rc);
             PaintTextLines(RC,FirstLine,LastLine,FirstCol,LastCol);
         end
@@ -3144,7 +3145,8 @@ type tcustomsynhighlighter = class(TSynHighLighter)
         fannotationcolor := 0xaa3300;
         fignorecase := false;//忽略大小写
         FChangeDeal := true;
-        FTokens := array();               
+        FTokens := array();  
+        fregs := array();             
         setkeyword(array("null","true","false","goto","break","for","to","while","do"));
         setblockannote(array(
                         ("/*","*/"),                        
@@ -3199,6 +3201,10 @@ type tcustomsynhighlighter = class(TSynHighLighter)
             begin
                 return setpairs(pm);
             end 
+            "regs":
+            begin
+                return setregs(pm);
+            end 
         end ;
         return inherited;        
     end 
@@ -3256,6 +3262,9 @@ type tcustomsynhighlighter = class(TSynHighLighter)
             if ifsysfun(bttk) then 
             begin
                 d.FFColor :=  fsysfuncolor ;   
+            end else 
+            begin
+                dereg(d,bttk);
             end 
             dopair(d,bttk);
         end else 
@@ -3324,6 +3333,17 @@ type tcustomsynhighlighter = class(TSynHighLighter)
             end 
         end 
     end 
+    function dereg(d,ttk);
+    begin
+        for i,v in fregs do 
+        begin
+            if parseregexpr(i,ttk,"",r,mp,ml)=1 then 
+            begin
+                d.FFColor := v;
+                return ;
+            end 
+        end 
+    end 
     function dopair(d,bttk); //处理配对信息
     begin
         if FIgnoreCase then 
@@ -3531,6 +3551,17 @@ type tcustomsynhighlighter = class(TSynHighLighter)
             end 
         end 
     end 
+    function setregs(d);
+    begin
+        fregs := array();
+        for rg,v in d do 
+        begin
+            if ifnil(v) then continue;
+            if not(rg and ifstring(rg)) then continue;  
+            fregs[rg] := v
+        end 
+        
+    end 
     function setpairs(d);//设置配对
     begin
         fswordpairs := array();
@@ -3648,7 +3679,8 @@ type tcustomsynhighlighter = class(TSynHighLighter)
     fsysfuntires;
     frowstires;
     fblockstiresa;
-    fblockstiresb;    
+    fblockstiresb;  
+    fregs;  
     /////
     fkeywordcolor;
     fsysfuncolor;