[Gambas-devel] Find your sub easier improved version

Yizhou He yizhou_he at ...143...
Thu Aug 5 07:26:40 CEST 2004


Hi: 
 
After read more source code of gambas and get some advise, I 
improved the function I proposed last time. Here is the changelog. 
it is write based on gambas-0.96. It still can not list the control 
of forms yet, I plan to make it list control under forms and by 
click it show the property of the control. 
 
Mr. Benoit Minisini, if you received my update on Chinese simplify 
translation, please let me know. 
 
 
Yizhou He 
 
'------- add sub in class FMain--------- 
PUBLIC SUB AddMethod(sClass AS String,sItemName AS String,iLine AS 
Integer) 
   
  IF NOT tvwProject.exist(sClass  & ":" & sItemName & "@" & iLine ) 
AND iLine<>0 THEN tvwProject.add(sClass  & ":" & sItemName & "@" & 
iLine,sItemName,picture["img/16/method.png"],sClass) 
  tvwProject.current.Expanded=TRUE 
   
END 
 
 
PUBLIC SUB ExpandClass(sClass AS String ) 
   
  tvwProject.Current.Expanded=TRUE 
   
END 
 
 
'------- Modify sub in class FMain---- 
PUBLIC SUB tvwProject_Activate() 
  DIM iAtPos AS Integer 
  DIM iLine AS Integer 
  DIM sLine AS String 
   
  IF tvwProject.Key THEN 
    IF CanEdit(tvwProject.Key) THEN 
      iAtPos=Instr(tvwProject.Key,"@") 
      IF iAtPos=0 THEN 
        iLine=0 
        sLine=tvwProject.Key 
      ELSE 
        sLine=Right(tvwProject.Key,Len(tvwproject.Key)-iAtPos) 
         
        iLine=CInt(sLine) 
        sLine=Left(tvwProject.Key,Instr(tvwProject.Key,":")-1) 
      ENDIF 
      Project.OpenFile(sLine,iLine) 
       
    ENDIF 
  ENDIF 
 
END 
 
 
'--------- Modify sub in class FEditor ----------- 
PUBLIC FUNCTION Save() AS Boolean 
 
  DIM iLig AS Integer 
  DIM iProc AS Integer 
  DIM iFull AS Integer 
  DIM sLig AS String 
  DIM iPosProc AS Integer 
  DIM sData AS String 
  DIM iLine AS Integer 
  DIM iCol AS Integer 
  DIM bChange AS Boolean 
  DIM iCount AS Integer 
  DIM iVoidLine AS Integer 
'----Yizhou He Start---------------- 
CreateMenu() 
'----Yizhou He End--------------- 
  IF Project.ReadOnly THEN RETURN 
  IF NOT $bModify THEN RETURN 
 
  Save.Begin(Path) 
 
  IF $bCleanOnSave THEN 
 
    iProc = -1 
    iLine = edtEditor.Line 
    iCol = edtEditor.Column 
 
    iCount = edtEditor.Lines.Count 
    FOR iLig = 0 TO iCount 
 
      IF iLig < iCount THEN 
        sLig = RTrim(edtEditor.Lines[iLig]) 
      ELSE 
        sLig = "SUB gambas()" 
      ENDIF 
 
      IF NOT LTrim(sLig) THEN 
        INC iVoidLine 
        CONTINUE 
      ENDIF 
 
      IF IsProc(sLig) THEN 
        IF iProc >= 0 THEN 
          IF iFull < 2 THEN 
            bChange = TRUE 
            sData = Left(sData, iPosProc) 
            IF iLine > iProc THEN 
              IF iLine < iLig THEN 
                iLine = iProc - 1 
              ELSE 
                iLine = iLine - (iLig - iProc + 1) 
              ENDIF 
            ENDIF 
          ENDIF 
        ENDIF 
        iProc = iLig 
        iFull = 0 
        iPosProc = Len(sData) 
      ELSE 
        INC iFull 
      ENDIF 
 
      IF iLig < iCount THEN 
        sData = sData & String(iVoidLine, "\n") & sLig & "\n" 
        iVoidLine = 0 
      ENDIF 
 
    NEXT 
 
    IF Len(sData) <> Len(edtEditor.Text) THEN 
 
      File.Save(Path, sData) 
 
      edtEditor.Frozen = TRUE 
      edtEditor.Text = sData 
      TRY edtEditor.Line = iLine 
      IF Error = 0 THEN 
        TRY edtEditor.Column = iCol 
      ENDIF 
      edtEditor.Frozen = FALSE 
 
    ENDIF 
 
  ENDIF 
 
  IF NOT bChange THEN File.Save(Path, edtEditor.Text) 
 
  $bModify = FALSE 
  DrawTitle 
 
  Save.End() 
 
CATCH 
 
  RETURN Save.Error() 
 
END 
 
 
'-------- Modify sub in class FEditor ----------- 
PUBLIC SUB Goto(iLine AS Integer, OPTIONAL iColumn AS Integer = -1) 
  DIM iPosEOL AS Integer 
  DIM iposSOL AS Integer 
  edtEditor.Line=iLine 
  edtEditor.Column=0 
  iPosEOL=edtEditor.Pos 
  edtEditor.Line = iLine - 1 
  iPosSOL=edtEditor.Pos 
  IF iColumn >= 0 THEN 
    edtEditor.Column = iColumn 
  ELSE 
    edtEditor.Select(iPosSOL,iPosEOL-iPosSOL-1) 
  ENDIF 
  createmenu 
END 
 
'------- Modify sub in class FEditor ---------- 
PRIVATE SUB CreateMenu() 
 
  DIM iInd AS Integer 
  DIM sLine AS String 
  DIM sName AS String 
  DIM hMenu AS Menu 
  DIM cFunc AS NEW String[] 
  DIM sParent AS String 
  DIM sNewParent AS String 
  DIM hParent AS Menu 
  DIM sFullName AS String 
  DIM sDesc AS String 
  DIM iPos AS Integer 
 
  'IF $hMenuGo THEN $hMenuGo.Delete 
 
  '$hMenuGo = NEW Menu(mnuEditor) 
  '$hMenuGo.Caption = "&Go to" 
 
  INC Application.Busy 
 
  mnuGoto.Children.Clear 
  $cLine.Clear 
 
  FOR iInd = 0 TO edtEditor.Lines.Count - 1 
 
    'sLine = edtEditor.Lines[iInd] 
    'PRINT sLine 
 
    IF IsProc(edtEditor.Lines[iInd]) THEN 
 
      IF NOT $cLine.Exist($sName) THEN 
 
        'PRINT $sName 
 
        'IF $bPublic THEN $sName = "#" & $sName 
 
        $cLine[$sName] = iInd 
        cFunc.Add($sName) 
 
      ENDIF 
 
    ENDIF 
 
  NEXT 
 
  cFunc.Sort(gb.Text) 
  hParent = mnuGoto 
'------ Yizhou He Start ------   
  project.ProjectTree[Path].Clear 
'------- Yizhou He End ------- 
 
 
'UNTIL project.ProjectTree[sFullName].Count=0 
 
  FOR EACH sName IN cFunc 
 
    'IF Left$(sName) = "#" THEN 
    '  sName = Mid$(sName, 2) 
    '  $bPublic = TRUE 
    'ELSE 
    '  $bPublic = FALSE 
    'ENDIF 
 
    sFullName = sName 
 
    iPos = Instr(sName, "_") 
    IF iPos THEN 
      sNewParent = Left$(sName, iPos - 1) 
      sName = Mid$(sName, iPos + 1) 
      IF Len(sNewParent) = 0 THEN 
        sNewParent = "(Special)" 
        sName = "_" & sName 
      ENDIF 
    ELSE 
      sNewParent = "" 
    ENDIF 
 
    IF UCase(sNewParent) <> UCase(sParent) THEN 
 
      IF sNewParent THEN 
 
        hParent = NEW Menu(mnuGoto) 
        hParent.Text = sNewParent 
 
      ELSE 
 
        hParent = mnuGoto 
 
      ENDIF 
 
      sParent = sNewParent 
 
    ENDIF 
 
    hMenu = NEW Menu(hParent) AS "mnuGoto" 
    hMenu.Text = sName 
    hMenu.Tag = sFullName 
    hMenu.Checked = $bPublic 
'----Yizhou He Start----- 
fmain.AddMethod(Path,sFullName,$cLine[sFullName]+1) 
'----Yizhou He End-----     
     
  NEXT 
 
  mnuGoto.Visible = $cLine.count > 0 
  mnuSepGoto.Visible = $cLine.count > 0 
  'mnuWatch.Visible = Project.Running 
  mnuWatch.Enabled = Project.Running AND 
Len(Trim(edtEditor.Selection.Text)) > 0 
  'btnWatch.Enabled = mnuWatch 
  'mnuSepWatch.Visible = Project.Running 
 
  DEC Application.Busy 
 
END 
 
 
Yizhou He 
Research Technician (Xiong Lab) 
Lineberger Comprehensive Cancer Center 
University of North Carolina at Chapel Hill 
Chapel Hill, NC 27599-7295 
Tel: (919)-962-2143 






More information about the Devel mailing list