dws2ideutils.pas

script language

        if StartingTable[i] is TUnitSymbol then begin
          if TUnitSymbol(StartingTable[i]).Table.FindLocal(LookupSym.Name) = nil then
//            Result := Result + ' - <script>'     // symbol is declared locally
          else
            Result := Result + ' - ' + StartingTable[i].Name; // symbol is declared in a unit
        end;
      end; {for}
  end;

  // pass in dictionary, do a findDeclaration and add the script line # if we can
end;

{-----------------------------------------------------------------------------
  Procedure: LoadUnitDeclaredSymbols
  Author:    Mark Ericksen
  Date:      18-Sep-2002
  Arguments: Prg: TProgram; UnitItemsList, UnitInserts: TStrings
  Result:    None
  Purpose:   Fill String lists with the symbols defined in 'TUnitSymbol' objects.
             These cannot be changed as the script changes and so only need to
             be processed once.
-----------------------------------------------------------------------------}
procedure LoadUnitDeclaredSymbols(Prg: TProgram; UnitItemsList, UnitInserts: TStrings;
                                  SynOptions: TdSyn_DisplayOptions;
                                  ContentOptions: TContentOptions;
                                  ClearLists: Boolean);
var
  i : Integer;
  AllTables: TList;

  procedure AddTable(Table : TSymbolTable);
  var
    i : Integer;
  begin
    if AllTables.IndexOf(Table) < 0 then begin
      AllTables.Add(Table);
      for i := 0 to Table.ParentCount - 1 do
        AddTable(Table.Parents[i]);
      if Table is TLinkedSymbolTable then
        AddTable(TLinkedSymbolTable(Table).Parent);
    end;
  end;

begin
  if ClearLists then begin
    UnitItemsList.Clear;
    UnitInserts.Clear;
  end;

  AllTables := TList.Create;
  try
    AddTable(Prg.Table);
    AllTables.Remove(Prg.Table);

    { Cycle the parents of the script (system table and declared units) }
    for i := 0 to AllTables.Count - 1 do
      LoadSymbolsToStrings(UnitItemsList, UnitInserts,
                           TSymbolTable(AllTables.Items[i]),
                           False, False, False, SynOptions);

    { Add Unit types - As very last entries in the list, add the unit names themselves }
    for i := Prg.Table.Count - 1 downto 0 do
      if Prg.Table[i] is TUnitSymbol then begin
        UnitInserts.Add(Prg.Table[i].Name);    // add unit name
        UnitItemsList.Add(GetSymbolAsText(nil, Prg.Table[i], SynOptions, ContentOptions));
      end;
  finally
    AllTables.Free;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: CompleteClassAtCursor
  Author:    Mark Ericksen
  Date:      07-Jan-2003
  Arguments: Compiler: TDelphiWebScriptII; AProgram: TProgram; CurrentLine, CurrentRow: Integer; ScriptText: TStrings; BareBonesImpl: Boolean
  Result:    Boolean
  Purpose:   Convenience wrapper that lets you easily attempt to complete any
             incomplete class that the cursor is inside of. (inside the context)
-----------------------------------------------------------------------------}
function CompleteClassAtCursor(Compiler: TDelphiWebScriptII; AProgram: TProgram;
                               CurrentLine, CurrentRow: Integer;
                               ScriptText: TStrings;
                               BareBonesImpl: Boolean): Boolean;
var
  Context: TContext;
begin
  Result := False;
  if Assigned(AProgram) then
  begin
    { Find the class that is to be completed }
    Context := AProgram.ContextMap.FindContext(CurrentRow, CurrentLine);
    if Assigned(Context) then
      if Context.ParentSym is TClassSymbol then
        Result := CompleteClass(Compiler, Context.ParentSym.Name{TClassSymbol(Context.ParentSym)}, ScriptText, BareBonesImpl);
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: CreateMethodImpl
  Author:    Mark Ericksen
  Date:      07-Jan-2003
  Arguments: Method: TMethodSymbol; InStrings: TStrings; BareBones: Boolean
  Result:    None
  Purpose:   Creates an implementation stub for a method. The BareBones flag
             when true will supress all parameters and return types.
-----------------------------------------------------------------------------}
procedure CreateMethodImpl(Method: TMethodSymbol; InStrings: TStrings; BareBones: Boolean);
var
  p: Integer;
  ParamText: string;
  FuncReturnType: string;
  FuncType: string;
begin
  Assert(Assigned(Method));
  Assert(Assigned(InStrings));
  { Assemble the method text piece-wise. }

  FuncReturnType := '';
  { Get string description of function type }
  case Method.Kind of
  fkFunction    :
    begin
      FuncType  := 'function';
      if (not BareBones) and Assigned(Method.Result) then
        FuncReturnType := ': '+Method.Typ.Caption;
    end;
  fkProcedure   :
    begin
      FuncType := 'procedure';
    end;
  fkConstructor :
    begin
      FuncType := 'constructor';
    end;
  fkDestructor  :
    begin
      FuncType := 'destructor';
    end;
  else
    FuncType  := '<unknown>';
  end;

  // Add 'class' to class methods
  if Method.IsClassMethod then
    FuncType := 'class ' + FuncType;

  ParamText := '';
  // load params for function
  if not BareBones then
  begin
    for p := 0 to Method.Params.Count - 1 do begin
      ParamText := ParamText + Method.Params[p].Caption;
      if p < Method.Params.Count - 1 then
        ParamText := ParamText + '; ';
    end;
    // Add parenthesis if there are params
    if ParamText <> '' then
      ParamText := '('+ParamText+')';
  end;

  InStrings.Add('');
  InStrings.Add(Format('%s %s.%s%s%s;', [FuncType, Method.ClassSymbol.Name, Method.Name, ParamText, FuncReturnType]));
  InStrings.Add('begin');
  InStrings.Add('');  //  // auto-generated');
  InStrings.Add('end;');
end;

{-----------------------------------------------------------------------------
  Procedure: CompleteAllClasses
  Author:    Mark Ericksen
  Date:      07-Jan-2003
  Arguments: Compiler: TDelphiWebScriptII; ScriptText: TStrings; BareBonesImpl: Boolean=False
  Result:    Boolean
  Purpose:   All classes will be completed by default. Only options are for
             how much detail should be added to the implementation (parameters
             and return type -- BareBonesImpl)
-----------------------------------------------------------------------------}
function CompleteAllClasses(Compiler: TDelphiWebScriptII;
                            ScriptText: TStrings;
                            BareBonesImpl: Boolean=False): Boolean;
begin
  // if one or more was built, will return true
  Result := CompleteClass(Compiler, '', ScriptText, BareBonesImpl);
end;

{-----------------------------------------------------------------------------
  Procedure: CompleteClass
  Author:    Mark Ericksen
  Date:      07-Jan-2003
  Arguments: Compiler: TDelphiWebScriptII; AClassName: string; ScriptText: TStrings; BareBonesImpl: Boolean=False
  Result:    Boolean
  Purpose:   If AClassName has a value then just that class will be completed.
             If AClassName is blank, then any incomplete class will be changed.
             BareBonesImpl means no parameters or return types will be added
             to the implementation. 
-----------------------------------------------------------------------------}
function CompleteClass(Compiler: TDelphiWebScriptII; AClassName: string;
                       ScriptText: TStrings; BareBonesImpl: Boolean=False): Boolean;
var
  i, x: Integer;
  method: TMethodSymbol;
  insertDeclLine: Integer;
  insertDeclCol: Integer;
  ErrorClassName: string;
  fixClassPos: TSymbolPosition;
  fixClass: TClassSymbol;   // class to complete
  locProgram: TProgram;   // local program used for recompiles and completion help
  ChangedInLoop: Boolean; // flag to denote if a change was made this time through the loop
begin
  Result := False;
  if (ScriptText = nil) then
    Exit;

  locProgram := CompileWithSymbolsAndMap(Compiler, ScriptText.Text);
  try
    { Take multiple passes. Recompile as we cycle and keep completing until nothing
      left to complete. Recompiles are needed because we stop compiling on
      error conditions. As the condition is satisfied, need to recompile to get
      further class members checked. }
    repeat
      ChangedInLoop := False;

      // needs to continously recompile the script until all possible changes have been made (re-collect pointers each time)
      for i := 0 to Length(locProgram.ClassCompleteNeeds) - 1 do
      begin
        Assert(Assigned(locProgram.ClassCompleteNeeds[i].ErrorClass));

        ErrorClassName := locProgram.ClassCompleteNeeds[i].ErrorClass.Name;
        { If no specific class is specified, fix errors with any class that has problems. }
        if AClassName = '' then
          fixClassPos := locProgram.SymbolDictionary.FindSymbolUsage(TSymbol(locProgram.ClassCompleteNeeds[i].ErrorClass), suDeclaration)
        else
          fixClassPos := locProgram.SymbolDictionary.FindSymbolUsageOfType(AClassName, TClassSymbol, suDeclaration);

        if not Assigned(fixClassPos) then
          raise Exception.CreateFmt('Class completion failed. Cannot find class "%s".', [ErrorClassName]);

        fixClass := TClassSymbol(fixClassPos.Symbol);        // get a shortcut for easer operation

        { If not completing all and the classes don't match, move to next item.
          The repeat..until will stop if no changes could be made }
        if (AClassName<>'') and (not SameText(AClassName, ErrorClassName)) then
          Continue;

        // property completion needed
        if locProgram.ClassCompleteNeeds[i].ErrorType = ccePropAccessDeclMissing then
        begin
          // default insert position to first line after class declaration
          insertDeclCol := fixClassPos.ScriptPos.Col + 1;
          insertDeclLine := fixClassPos.ScriptPos.Line + 1;

          // cycle the members, find first place fit for new declaration
          for x := 0 to fixClass.Members.Count - 1 do
          begin
            // if a Field, default new position to be AFTER the field.
            if fixClass.Members[x] is TFieldSymbol then
              insertDeclLine := locProgram.SymbolDictionary.FindSymbolUsage(fixClass.Members[x], suDeclaration).ScriptPos.Line + 1;
          end; {for x}
          // insert the completed property information
          ScriptText.Insert(insertDeclLine-1, StringOfChar(' ', insertDeclCol) +
                                              locProgram.ClassCompleteNeeds[i].SuggestedFix);
          Result := True;    // a change was successfully made
          ChangedInLoop := True;
        end; {property completion}

        { Method implementation completion }
        if locProgram.ClassCompleteNeeds[i].ErrorType = cceMethodImplMissing then
        begin
          for x := 0 to fixClass.Members.Count - 1 do
            if fixClass.Members[x] is TMethodSymbol then
            begin
              method := fixClass.Members[x] as TMethodSymbol;
              { If the method is not abstract and is declared here but not implemented }
              if not method.IsAbstract and
                 Assigned(locProgram.SymbolDictionary.FindSymbolUsage(method, suDeclaration)) and
                 (locProgram.SymbolDictionary.FindSymbolUsage(method, suImplementation) = nil) then
              begin
                CreateMethodImpl(method, ScriptText, BareBonesImpl);
                Result := True;    // at least one was built
                ChangedInLoop := True;
              end;
            end;
        end;
      end; {for i}

      { Recompile - free program, compile new one }