PROGRAM AddTrace;
{-- ***************************************************************************
 -- ** Descr. : Add Trace support to FMB.
 -- **
 -- ** MINVERS:
 -- ***************************************************************************
 -- ** 14/03/04 1.001.00 Initial Creation, yuri_slutsky@yahoo.com 
 -- ***************************************************************************}
{*Types Declaration*}
TYPE
   TUnitRecord=record
      ProgName       : varchar2;
      Declaration    : varchar2;
      isFunction     : boolean;
      ReturnDatatype : varchar2;
   end;
type TUnitList=array of TUnitRecord;
TYPE
   TParameterRecord=record
      p_Name    : varchar2;
      In_Out    : varchar2;
      Datatype  : varchar2;
   end;
type TParameterList=array of TParameterRecord;

{*Global Variable Declaration*}
VAR
  v_filename       : varchar2;
  v_save_filename  : varchar2;
  i,j,m,k,h,n,ll,nn: number;
  frm,spos,spos1   : number;
  att_lib          : varchar2;
  src_orig,s,ss,t  : varchar2;
  dBeg,dEnd        : varchar2;
  dComment         : varchar2;
  UnitName         : varchar2;
  src_WithoutComments : TStringList;
  ps               : TParamScreen;
  pb               : TParamBoard;
  files,UnitText   : TStringList;
  NewUnitText      : TStringList;
  UnitList         : TStringList;
  InsStr           : TStringList;
  ParameterList    : TParameterList;
  ProgUnitList     : TUnitList;
  ProgUnitListCount: number;
  ItemList         : TStringList;
  isToolbar        : boolean;
  isProgramUnit    : boolean;
  ButtonForCopy    : number;
  Canvas           : varchar2;
  Tab              : varchar2;
  Block            : varchar2;

  function HowMatch(p:varchar2;p_str:varchar2):number;
  var
    counter :number;
    pos     :number;
  begin
    counter := -1;
    pos := 0;
    repeat
      pos := instr(p,p_str,pos+1);
      counter := counter + 1;
    until pos = 0;
    HowMatch := counter;
  end;

  function GetStatement(p:varchar2;p_start:number;var next_pos:number):varchar2;
  var
    rc,t  : varchar2;
    p_end : number;
  begin
    t := blendout_plsql_comments(p);
    p_end := p_start-1;
    repeat
      p_end :=  InStr(t,';',p_end+1);
    until (p_end = 0) or
          (frac(HowMatch(substr(t,p_start,p_end - p_start),'''')/2) = 0);
    if p_end = 0 then
      next_pos := p_end
    else
      next_pos := p_end + 1;
    GetStatement := substr(t,p_start,p_end - p_start);
  end;

  function FirstNotNullLine(t:TStringList):varchar2;
  var
    i           : number;
    rc          : varchar2;
    s           : varchar2;
  begin
    for i := 0 to t.count-1 do
    begin
      s :=ctrim(t.strings[i]);
      if (s <> '') then
      begin
        rc := s;
        break;
      end;
    end;
    FirstNotNullLine := rc ;
  end;

  function GetDeclaration(t:TStringList):varchar2;
  var
    i           : number;
    rc          : varchar2;
    s           : varchar2;
  begin
    i := 1;
    s := GetNextWord(t.text,' '+#10+#13+#09, i) + ' ';
    while (i > 0) and (s <> 'IS ') do
    begin
      if (s <> ' ') then
      begin
        rc := rc + s ;
        s  := GetNextWord(t.text,' '+#10+#13+#09, i) + ' ';
      end;
    end;
    GetDeclaration := rc ;
  end;

  function GetParameters(p:varchar2;var lim:number):TParameterList;
  var
    i,ii,n,k,nn : number;
    rc          : TParameterList;
    s,ss,t      : varchar2;
  begin
  try
    lim := 0;
    SetLength(rc,0);
    i := InStr(p,'(');
    if i <> 0 then
    begin
      lim := HowMatch(p,',')+1;
      SetLength(rc,HowMatch(p,',')+1);
      n := 0;
      s := substr(p,i + 1 ,InStr(p,')') - i - 1); // parameters list
      i := 0;
      repeat
        ii := InStr(s,',',i + 1);
        if ii = 0 then
          ss := substr(s,i + 1)
        else
          ss := substr(s,i + 1,ii - i - 1);
        ss := ctrim(ss);
        // parameter declaration
        k := InStr(ss,':=');
        if k > 0 then
          ss := substr(ss,1,k - 1);
        k := InStr(ss,'DEFAULT');
        if k > 0 then
          ss := substr(ss,1,k - 1);
        ss := replace(ss,'NOCOPY','',true);
        rc[n].p_name := getFirstWord(ss);
        k := CountWords(ss);
        nn := 1;
        if k = 2 then
        begin
          rc[n].in_out := 'IN';
          rc[n].datatype := substr(ss,InStr(ss,' ') + 1);
        end else
          if k = 4 then
          begin
            rc[n].in_out := 'INOUT';
            nn := InStr(ss,' ');
            nn := InStr(ss,' ',nn+1);
            nn := InStr(ss,' ',nn+1);
            rc[n].datatype := substr(ss,nn+1);
          end else
          begin
            nn := InStr(ss,' ');
            k := InStr(ss,' ',nn);
            rc[n].in_out := ctrim(substr(ss,nn + 1,k-nn-1));
            rc[n].datatype := ctrim(substr(ss,k+1));
          end;
        i := ii;
        n := n + 1;
      until i = 0;
    end;
    GetParameters := rc ;
  except
    logadd('GetParameters =>'+GetError,LogError);
    raise;
  end;
  end;

  procedure AddBefore(ss:varchar2;isFunction:boolean);
  var
    t,nextword :varchar2;
    k,h,n      :number;
  begin
  try

--logadd('Search '||ss);
--Logadd('***********Count '+inttostr(NewUnitText.count));
    spos := 0;
    ll := 0;
    repeat
      spos := instr(src_WithoutComments.text,ss,spos+1);
      if spos > 0 then
      begin
        h := Get_LineNumberAtPos(src_WithoutComments.text,spos);
--logadd('h '+inttostr(h));
        s := src_WithoutComments.strings(h);
        n := instr(s,ss);
        if IsInside(ss,['RETURN']) then
          nextword := GetNextWord(src_WithoutComments.text,
                            ' ',spos+length(ss))
        else
          nextword := GetNextWord(src_WithoutComments.text,
                            C_PLSQL_DELIMITERS,spos+length(ss));
        if (
            (n = 1) or (IsInside(substr(s,n - 1,1),[' ',#8,#9,#10,';'])) and
            (IsInside(substr(src_WithoutComments.text,spos + length(ss),1),
                   [' ',#8,#9,#10,';']))
           )
           and
           (
             not (
                 (IsInside(ss,['RETURN'])) and
                 (
                  (IsInside(nextword,
                   ['BOOLEAN','CHAR','VARCHAR2','INTEGER','NUMBER','DATE'])
                   or (instr(nextword,'%TYPE') > 0)
                   or (instr(nextword,'%ROWTYPE') > 0)
                  )
                  )
                 )
             or  not (IsInside(ss,['RETURN']))
           )
           and
           (
             not (
                 (IsInside(ss,['EXCEPTION'])) and
                 (
                 (IsInside(GetNextWord(src_WithoutComments.text,
                    ' '+#10+#13+#09,spos+length(ss)),
                     [';']))
                 or (IsInside(substr(src_WithoutComments.text,spos+length(ss),1),[';']))
                  )
                 )
             or  not (IsInside(ss,['EXCEPTION']))
           )then
        begin
          h := h + ll;
--logadd('ll '+inttostr(ll));
          if IsInside(ss,['END;','EXCEPTION']) then
            s := lpad(' ',n + 1)+'t.ProgEnd('''+UnitName+''');'+dComment
          else
            if IsInside(ss,['RAISE']) then
              s := lpad(' ',n - 1)+'t.ProgEnd('''+UnitName+''');'+dComment
            else // return
              if not isFunction then
              begin
                s := lpad(' ',n - 1)+'t.ProgEnd('''+UnitName+''');'+dComment;
end
              else
              begin
                // find return value
                t := GetStatement(src_WithoutComments.text,spos,k);
                t := ctrim(substr(t,length(ss)+1));
                k := 1;
                if getNextWord('j '+t+' j',C_PLSQL_DELIMITERS,k) = 'NULL' then
                  t := '''NULL''';
                s := lpad(' ',n - 1)+'t.p(''Return value:''); ';
                s := s+'t.p(' + t +');'+dComment;
              end;
--Logadd('hhhhhh '+inttostr(h));
--Logadd('Count '+inttostr(NewUnitText.count));

          NewUnitText.Insert(h,s);
--          src_WithoutComments.Insert(h,LPad(' ',length(s),' '));
--Logadd('------hhhhhh '+inttostr(h));
--Logadd('------Count '+inttostr(NewUnitText.count));
          ll := ll + 1;
        end;
      end;
     until spos=0; //repeat until no more occurences found
   except
     logadd('AddBefore =>'+UnitName+': '+' for '+ss+' '+GetError,LogError);
     raise;
   end;
   end;

  procedure AddAfter(ss:varchar2;sss:TStringList);
  var
    k,h,n  :number;
  begin
  try
    spos := 0;
    ll := 0;
    repeat
      spos := instr(src_WithoutComments.text,ss,spos+1);
      if spos > 0 then
      begin
        h := Get_LineNumberAtPos(src_WithoutComments.text,spos);
        s := src_WithoutComments.strings(h);
        n := instr(s,ss);
        h := h + ll;
        NewUnitText.Insert(h+1,lpad(' ',n + 1)+'t.ProgStart('''+UnitName+''');'+dComment);
        ll := ll + 1;
        for k := 0 to sss.count - 1 do
        begin
          NewUnitText.Insert(h+2,lpad(' ',n + 1)+sss.strings[k]+dComment);
          ll := ll + 1;
        end;
      end;
     until spos=0; //repeat until no more occurences found
   except
     logadd('AddAfter =>'+UnitName+': '+' for '+sss.text+' '+GetError,LogError);
     logadd(src_WithoutComments.text);
     raise;
   end;
   end;
{*Main Program Block*}
BEGIN
    //build together a nice parameter screen ...
  ps := TParamScreen.create;
  pb := ps.AddBoard('Modules',picModules);
  pb.addparam(parLabel,'MYLABEL','This script add or replace tracing support to forms.','','');
  pb.addparam(parPathname,'MODPATH','Check Path','','');
  pb.addparam(parFiles,'MODULES','Modules','','Forms Modules(*.fmb)|*.fmb');
  pb.addparam(parPathname,'SAVEPATH','Save Path','','');
  pb.addparam(parRadioGroup,'MYRG1','Work type','Trace+Compilation',
                                  'Compilation'+c_cr+'Add trace'+c_cr+'Trace+Compilation'+
                                  c_cr+'Remove Trace'+c_cr+'Remove+Compilation');
  pb.addparam(parFilename,'ATT_LIB','Attach Library','','PLSQL Library (*.pll)|*.pll');
  pb.addparam(parDatabaseLogon,'MYDATABASE','DB Connection','','');
  ps.parambyname('MYDATABASE').isNewGroup := true;

  //show the parameter screen and wait for inputs
  if ps.ShowParamScreen('Attach debug support to forms ...') then
  begin
//      LogParamScreen(ps);
    try
      api_Connect(ps.ParamValue('MYDATABASE'));
    except
    end;
    if (
        (ps.ParamByName('MODPATH').value ='\') or
        (ps.ParamByName('MODPATH').value ='\')
        ) and
       (ps.ParamByName('MODULES').value ='')  then
      raiseException('Missing Check Path!');
    if ps.paramvalue('SAVEPATH') ='' then
      RaiseException('Please specify a path to save the modules to!');
    dComment := '--## Don''t remove ##';
    //get all the selected files into a list
    if (ps.ParamByName('MODULES').value <> '') then
      begin
        files  := TStringList.create;
        files.text := ps.paramvalue('MODULES');
      end else
        files := GetFileList(ps.ParamByName('MODPATH').value,'*.fmb;*.mmb;',
                             true);
    files.sort;
    att_lib := upper(ChangeFileExt(ExtractFileName(ps.paramvalue('ATT_LIB')),''));
    //loop through the list of selected files
    for j := 0 to files.count-1 do
    begin
    v_filename := files.strings[j];
    v_save_filename := rtrim(ps.ParamValue('SAVEPATH'),'\')+'\'+ExtractFileName(v_filename);
    logadd(to_char(j+1)+'/'+to_char(files.count)+' '+v_filename);
      try
      // load the forms module
        frm := API_LoadModule(v_filename);
        if IsInside(ps.paramvalue('MYRG1'),['Add trace','Trace+Compilation',
                                            'Remove Trace','Remove+Compilation']) then
        begin
          if att_lib <>'' then
          begin
            //get a list of all PL/SQL Libraries in this formsmodule
            UnitList := API_GetSubObjects(frm, D2FP_ATT_LIB);
            //and loop through the whole list
            for i := 0 to UnitList.count-1 do
            begin
              //has the library to be deleted ?!
              if att_lib = API_GetObjectName( UnitList.objects[i] ) then
              begin
                PLSQLLib_Detach( UnitList.objects[i] );
              end;
            end;
            if IsInside(ps.paramvalue('MYRG1'),['Add trace','Trace+Compilation']) then
              PLSQLLIB_Attach(frm,att_lib);
          end;
          // Check if Horizontal Toolbar exists
          s := Generic_GetTextProp(frm,D2FP_HORZ_TLBR_CNV);
          if s = '' then
            s := Generic_GetTextProp(frm,D2FP_VERT_TLBR_CNV);
          if s = '' then  // Toolbar canvas not used
          // take first block
          begin
            s := Generic_GetTextProp(frm,D2FP_FRST_NAVIGATION_BLK_NAM);
            if s = '' then
              m := Generic_GetObjProp(frm, D2FP_BLOCK)
            else
            begin
              m := Generic_GetObjProp(frm, D2FP_BLOCK);
              while m <> 0 do
              begin
                if upper(Generic_GetTextProp(m, D2FP_NAME)) = s then
                  break;
                m := Generic_GetObjProp(m, D2FP_NEXT);
              end;
            end;
          end else // Toolbar canvas found
          begin
          // Seek TOOLBAR block with Toolbar canvas
            m := Generic_GetObjProp(frm, D2FP_BLOCK);
            isToolbar := false;
            while m <> 0 do
            begin
              ItemList := API_GetSubObjects(m,D2FP_ITEM);
              for i := 0 to ItemList.count-1 do
              begin
                if Generic_GetTextProp(ItemList.objects[i], D2FP_CNV_NAM) = s then
                begin
                  isToolbar := true;
                  break;
                end;
              end;
              ItemList.free;
              if isToolbar then
                break;
              m := Generic_GetObjProp(m, D2FP_NEXT);
            end;
          end;
          Block := Generic_GetTextProp(m, D2FP_NAME);
          //m - pointer to block where is placing the trace button
          // Add new button Trace on/off
          // check if button DEBUG exists already
          ItemList := API_GetSubObjects(m,D2FP_ITEM);
          n := 0;
          for i := 0 to ItemList.count-1 do
          begin
            if upper(Generic_GetTextProp(ItemList.objects[i], D2FP_NAME)) = 'DEBUG' then
              Generic_Destroy(ItemList.objects[i]);
            if n = 0 then
              if (Generic_GetBoolProp(ItemList.objects[i],D2FP_VISIBLE)) and
                 ( Generic_GetTextProp(ItemList.objects[i],D2FP_CNV_NAM) <> '') then
              begin
                n := ItemList.objects[i];
                Canvas := Generic_GetTextProp(n,D2FP_CNV_NAM);
                Tab    := Generic_GetTextProp(n,D2FP_TBP_NAM);
              end;
          end;
          ItemList.free;
          if IsInside(ps.paramvalue('MYRG1'),['Add trace','Trace+Compilation']) then
          begin
            //button creating
            n := Generic_Create(m,'DEBUG',D2FFO_ITEM);
            Generic_SetNumProp(n,D2FP_ITM_TYP,D2FC_ITTY_PB);  // button
            Generic_SetTextProp(n,D2FP_CNV_NAM,Canvas);
            Generic_SetTextProp(n,D2FP_TBP_NAM,Tab);
            Generic_SetTextProp(n,D2FP_LABEL,'trace');
            Generic_SetTextProp(n,D2FP_TOOLTIP,'trace');
            Generic_SetTextProp(n,D2FP_ICON_FLNAM,'green');
            Generic_SetBoolProp(n,D2FP_ICONIC,true);
            Generic_SetBoolProp(n,D2FP_KBRD_NAVIGABLE,false);
            Generic_SetBoolProp(n,D2FP_MOUSE_NAVIGATE,false);
            Generic_SetNumProp(n,D2FP_ITMS_DISP,1);
            Generic_SetNumProp(n,D2FP_HEIGHT,300);
            Generic_SetNumProp(n,D2FP_WIDTH,300);
            Generic_SetNumProp(n,D2FP_Y_POS,0);
            Generic_SetNumProp(n,D2FP_X_POS,0);
            n := Generic_Create(n,'WHEN-BUTTON-PRESSED',D2FFO_TRIGGER);
          // write Debug WHEN-BUTTON-PRESSED trigger text
            s := 'declare' + c_cr +
               '  FileId   text_io.file_type;' + c_cr +
               '  Line     varchar2(2000);' + c_cr +
               '  Stmt     varchar2(32000);' + c_cr +
               '  Temp     varchar2(32000);' + c_cr +
               '  ok       boolean;' + c_cr +
               'begin' + c_cr +
               '  if get_item_property('''+Block+'.debug'',ICON_NAME) =''green'' then' + c_cr +
               '-- debug on' + c_cr +
               '    set_item_property('''+Block+'.debug'',ICON_NAME,''blue'');' + c_cr +
               '    t.traceon;' + c_cr +
               '    t.p(''Logon: ''||Get_Application_Property(USERNAME)||''/...@''||' + c_cr +
               '                   Get_Application_Property(CONNECT_STRING));' + c_cr +
               '    t.p(''Current Form: ''||Get_Application_Property(CURRENT_FORM));' + c_cr +
               '    t.p(''Calling Form: ''||Get_Application_Property(CALLING_FORM));' + c_cr +
               '  else' + c_cr +
               '-- debug off' + c_cr +
               '    set_item_property('''+Block+'.debug'',ICON_NAME,''green'');' + c_cr +
               '    t.traceoff;' + c_cr +
               '    begin' + c_cr +
               '      FileId := text_io.fopen(t.TempDir||t.TraceFileName,''r'');' + c_cr +
               '    exception' + c_cr +
               '      when others then' + c_cr + 'return;' + c_cr +
//             '        message(''File ''||t.TempDir||t.TraceFileName||' + c_cr +
//             '                '' not opened'');pause;' + c_cr +
               '    end;' + c_cr +
               '    Stmt := null;' + c_cr +
               '    begin' + c_cr +
               '      text_io.get_line(FileId,Line);' + c_cr +
               '      loop' + c_cr +
               '        text_io.get_line(FileId,Line);' + c_cr +
               '        Temp := Temp ||chr(10)||ltrim(Line);' + c_cr +
               '        if instr(Line,''[Error]'') > 0 then' + c_cr +
               '          Stmt := Line;' + c_cr +
               '          text_io.get_line(FileId,Line);' + c_cr +
               '          Temp := Temp ||chr(10)||ltrim(Line);' + c_cr +
               '          Stmt := Stmt||chr(10)||ltrim(Line);' + c_cr +
               '        end if;' + c_cr +
               '      end loop;' + c_cr +
               '       text_io.fclose(FileId);' + c_cr +
               '    exception' + c_cr +
               '      when others then' + c_cr +
               '        text_io.fclose(FileId);' + c_cr +
               '        if Stmt is not null then' + c_cr +
               '          set_alert_property(''ERROR'',ALERT_MESSAGE_TEXT,Stmt);' + c_cr +
               '          if show_alert(''ERROR'') = ALERT_BUTTON2 then' + c_cr +
               '--            show_editor(''show_ed'',Temp,Temp,ok);' + c_cr +
               '            null;' + c_cr +
               '          end if;' + c_cr +
               '        end if;' + c_cr +
               '    end;' + c_cr +
               '  end if;' + c_cr +
               'end;';
            Generic_SetTextProp(n,D2FP_TRG_TXT,s);
          end;
          // Get program units list only
          UnitList := API_GetSubObjects(frm, D2FP_PROG_UNIT);
          ProgUnitListCount := UnitList.count;
          SetLength(ProgUnitList,ProgUnitListCount);
          for i := 0 to ProgUnitListCount - 1 do
          begin
             if IsInside(Generic_GetNumProp(UnitList.objects[i], D2FP_PGU_TYP),[1,2]) then
             // procedure and function only
             begin
               ProgUnitList[i].ProgName   := Generic_GetTextProp(UnitList.objects[i], D2FP_NAME);
               src_WithoutComments := TStringList.create;
               src_orig := API_GetPLSQL(UnitList.objects[i]);
               src_WithoutComments.text := upper(blendout_plsql_comments(src_orig));
               ProgUnitList[i].Declaration  := GetDeclaration(src_WithoutComments);
               ProgUnitList[i].isFunction := Generic_GetNumProp(UnitList.objects[i], D2FP_PGU_TYP) = 2;
             end;
          end;
          // Add trace support to all program unit
          UnitList  := API_GetAllSourceObjects(frm);
          //loop thorough all sourcecode objects
          for i := 0 to UnitList.count-1 do
          begin
//          if Generic_IsSubClassed(UnitList.objects[i]) then
//            continue; //ignore subclassed items, 'continue' to next loop!
            src_orig := API_GetPLSQL(UnitList.objects[i]);
            // remove old debug support
            UnitText := TStringList.create;
            NewUnitText := TStringList.create;
            src_WithoutComments := TStringList.create;
            UnitText.text := src_orig;
            src_WithoutComments.text := upper(blendout_plsql_comments(src_orig));
            s := API_GetObjectPath(UnitList.objects[i]);
            isProgramUnit := (instr(s,'Program Units') > 0) and
                             (IsInside(Generic_GetNumProp(UnitList.objects[i], D2FP_PGU_TYP),[1,2]));
            if not (isProgramUnit) and
               (
               (like(FirstNotNullLine(src_WithoutComments),'PACKAGE*')) or
               (instr(s,'FORMULA-CALCULATION') > 0 ) or
               (instr(s,'Record Groups') > 0 ) or
               (instr(s,Block+'.Items.DEBUG.Triggers.WHEN-BUTTON-PRESSED') > 0 )
               )
                 then
              continue;
            s := substr(s,inStr(s,'.')+1);
            UnitName := substr(s,inStr(s,'.')+1);
            for n := 0 to UnitText.count-1 do
              if  instr(UnitText.strings(n),dComment) = 0 then
                k := NewUnitText.add(UnitText.strings(n));
            if IsInside(ps.paramvalue('MYRG1'),['Add trace','Trace+Compilation']) then
            begin
              // Search return/raise statements
              src_WithoutComments.text := upper(blendout_plsql_comments(NewUnitText.text));
              AddBefore('RAISE ',false);
              src_WithoutComments.text := upper(blendout_plsql_comments(NewUnitText.text));
              AddBefore('EXCEPTION',false);
              src_WithoutComments.text := upper(blendout_plsql_comments(NewUnitText.text));
              if isProgramUnit then
              begin
                s := substr(UnitName,inStr(UnitName,'.')+1);
                // search Unit row in ProgUnitList
                k := -1;
                repeat
                  k := k + 1;
                until ProgUnitList[k].ProgName = s;
                //
                if ProgUnitList[k].isFunction then
                begin
                  AddBefore('RETURN',true);
                end else
                begin
                  AddBefore('END;',false);
                end;
                src_WithoutComments.text := upper(blendout_plsql_comments(NewUnitText.text));
                InsStr := TStringList.create;
                if ProgUnitList[k].Declaration <> '' then
                begin
                // add parameters trace
                  ParameterList := GetParameters(ProgUnitList[k].Declaration,nn);
                  for n := 0  to nn - 1 do
                  begin
                    t := ParameterList[n].p_name;
                    if (ParameterList[n].in_out <> 'OUT') and
                       (
                        (IsInside(ParameterList[n].datatype,
                         ['BOOLEAN','CHAR','VARCHAR2','INTEGER','NUMBER','DATE'])
                        or
                         (instr(ParameterList[n].datatype,'%TYPE') > 0)
                         or
                         (instr(ParameterList[n].datatype,'%ROWTYPE') > 0)
                       )
                       ) then
                    begin
                      if ParameterList[n].datatype <> 'BOOLEAN' then
                        h := InsStr.add('t.p('''+t+' = ''||'+t+');')
                      else
                      begin
                        h := InsStr.add('END IF;');
                        h := InsStr.add('  t.p('''+t+' = false'''+');');
                        h := InsStr.add('ELSE');
                        h := InsStr.add('  t.p('''+t+' = true'''+');');
                        h := InsStr.add('IF '+t+ ' THEN');
                      end;
                    end;
                  end;
                end;
                AddAfter('BEGIN',InsStr);
                InsStr.free;
                src_WithoutComments.text := upper(blendout_plsql_comments(NewUnitText.text));
              end else
              begin
                s := '';
                if instr(UnitName,'WHEN-NEW-FORM-INSTANCE') > 0 then
                // Add code for WHEN-NEW-FORM-INSTANCE trigger only
                  s := 'if t.isTrace then'+dComment+c_cr+
                 't.p(''------Calling Form: ''||Get_Application_Property(CALLING_FORM));'
                  +  dComment+c_cr +
                 't.p(''------Current Form: ''||Get_Application_Property(CURRENT_FORM));'
                  +  dComment+c_cr +
                       '  set_item_property('''+Block+'.debug'',ICON_NAME,''blue'');'
                       +dComment+c_cr
                       +'else'+dComment+c_cr
                       +'  set_item_property('''+Block+'.debug'',ICON_NAME,''green'');'
                       +dComment+c_cr+'end if;'+dComment+c_cr;
                NewUnitText.text := 'begin'+dComment+c_cr+s+
                                    '  t.ProgStart('''+
                            UnitName+''');'+dComment+c_cr+'end;' + dComment +
                            c_cr + NewUnitText.text;
                NewUnitText.text := NewUnitText.text+
                                  'begin'+dComment+c_cr+'  t.ProgEnd('''+ UnitName+''');'
                                  +dComment+c_cr+'end;'+dComment;
              end;
              src_WithoutComments.text := upper(blendout_plsql_comments(NewUnitText.text));
              AddBefore('RETURN',false);
              // Search procedures or function calls    ???????????????????????????????
              src_WithoutComments.text := upper(blendout_plsql_comments(NewUnitText.text));
//              nn := 1;
//              repeat
//                s  := GetStatement(src_WithoutComments.text,nn); -- statement
//              nn := n;
//              until n = 0;
              //
            end;
            API_SetPLSQL(UnitList.objects[i],NewUnitText.text);
          end;
          UnitList.free;
          NewUnitText.free;
          //save the module to the new path
          API_SaveModule(frm,v_save_filename);
          API_DestroyModule(frm);
          frm := API_LoadModule(v_save_filename);
        end; // if Add trace
        if IsInside(ps.paramvalue('MYRG1'),['Compilation','Trace+Compilation',
                                            'Remove+Compilation']) then
        begin
          if FileExists(ChangeFileExt(v_save_filename,'')+'.err') then
             DeleteFile(ChangeFileExt(v_save_filename,'')+'.err');
          if  API_GenerateModule(frm) = false then
            LogAdd(v_save_filename+'-> Compilation failed!',LogError)
          else
            LogAdd(v_save_filename+'-> Compilation OK!');
        end;
        API_DestroyModule(frm);
      except
       // ups! an error happened, so just log it and proceed to the next module
       logadd('Main =>'+GetError,LogError);
      end;
    end;
    //free the file list from memory;
    files.free;
    API_Disconnect;
  end else
  begin
    //user must have pressed cancel on parameterscreen
    logadd('Canceled on parameterscreen!');
  end;
  // free the parameter screen
  ps.free;
END.