dws2symbolstotree.pas

script language

{**********************************************************************}
{                                                                      }
{    "The contents of this file are subject to the Mozilla Public      }
{    License Version 1.1 (the "License"); you may not use this         }
{    file except in compliance with the License. You may obtain        }
{    a copy of the License at                                          }
{                                                                      }
{    http://www.mozilla.org/MPL/                                       }
{                                                                      }
{    Software distributed under the License is distributed on an       }
{    "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express       }
{    or implied. See the License for the specific language             }
{    governing rights and limitations under the License.               }
{                                                                      }
{    The Original Code is dws2SymbolsToTree source code, released      }
{    October 26, 2002                                                  }
{                                                                      }
{    The Initial Developer of the Original Code is Mark Ericksen       }
{    Portions created by Mark Ericksen are                             }
{    Copyright (C) 2002 Mark Ericksen, United States of America.       }
{    All Rights Reserved.                                              }
{                                                                      }
{**********************************************************************}
unit dws2SymbolsToTree;

interface

uses SysUtils, Classes, Graphics, dws2Comp, dws2Exprs, dws2Symbols, dws2Errors,
     ComCtrls;

{ Images used for Tree node graphics are semi-defined in dws2IDEUtils.pas. }

// Format the tree to coincide with the layout of a Tdws2Unit
procedure SymbolsToUnitTree(AProgram: TProgram; Tree: TTreeView);
// Format the tree to work like the default Delphi Code Explorer
procedure SymbolsToDefaultDelphiTree(AProgram: TProgram; Tree: TTreeView);
//
function CreateNewNode(ParentNode: TTreeNode; Text: string; ImgIndex: Integer; Tree: TTreeView; DataPtr: Pointer): TTreeNode;
function AddSymbolToTree(ParentNode: TTreeNode; Tree: TTreeView; Symbol: TSymbol;
                         SymPos: TSymbolPosition): TTreeNode;

// Remove root nodes that have no 'Data' assigned to them.
procedure PruneEmptyNodes(Tree: TTreeView);

implementation

uses dws2IDEUtils;

{-----------------------------------------------------------------------------
  Procedure: CreateFolderNode
  Author:    Mark Ericksen
  Date:      19-Oct-2002
  Arguments: Text: string; ImgIndex: Integer; Tree: TTreeView
  Result:    TTreeNode
  Purpose:   Create a root node on the tree for containing a category of items.
-----------------------------------------------------------------------------}
function CreateNewNode(ParentNode: TTreeNode; Text: string; ImgIndex: Integer; Tree: TTreeView; DataPtr: Pointer): TTreeNode;
begin
  Result := Tree.Items.AddChildObject(ParentNode, Text, DataPtr);
  Result.ImageIndex    := ImgIndex;
  Result.SelectedIndex := ImgIndex;
end;

{-----------------------------------------------------------------------------
  Procedure: AddSymbolToTree
  Author:    Mark Ericksen
  Date:      19-Oct-2002
  Arguments: ParentNode: TTreeNode; Symbol: TSymbol; SymPos: TSymbolPosition
  Result:    TTreeNode
  Purpose:   Add the symbol to the tree (specified node). Link the Symbol
             position to the node for navigation.
-----------------------------------------------------------------------------}
function AddSymbolToTree(ParentNode: TTreeNode; Tree: TTreeView; Symbol: TSymbol;
    SymPos: TSymbolPosition): TTreeNode;
var
  idx: Integer;
  CanAdd: Boolean;
begin
  Result := nil;
  CanAdd := False;
  if (not Assigned(ParentNode)) or (not Assigned(SymPos)) then
    Exit;
  idx := imgFolder;
  { Classes and Forwards }
  if Symbol is TClassSymbol then
  begin
    idx    := imgClass;
    CanAdd := True;
  end
  { Procedures }
  else if Symbol is TFuncSymbol then
  begin
    case TFuncSymbol(Symbol).Kind of
    fkFunction    : idx := imgFunc;
    fkProcedure   : idx := imgProc;
    fkConstructor : idx := imgConstruct;
    fkDestructor  : idx := imgDestruct;
    end;
    CanAdd := True;
  end
  { Types }
  else if Symbol is TTypeSymbol then
  begin
    idx := imgType;
    CanAdd := True;
  end
  { Properties (Also TValueSymbol so check for it first) }
  else if Symbol is TPropertySymbol then
  begin
    idx    := imgProp;
    CanAdd := True;
  end
  { Variables and Constants (not function parameters) }
  else if (Symbol is TValueSymbol) and (not (Symbol is TParamSymbol)) then
  begin
    if Symbol is TConstSymbol then
      idx := imgConst
    else
      idx := imgVar;
    CanAdd := True;
  end
  { Unit symbols }
  else if Symbol is TUnitSymbol then
  begin
    idx    := imgUnit;
    CanAdd := True;
  end;
  //
  { Add symbol under appropriate parent with data attached }
  if CanAdd then
    Result := CreateNewNode(ParentNode, Symbol.Name, idx, Tree, SymPos);
end;

{-----------------------------------------------------------------------------
  Procedure: SymbolsToUnitTree
  Author:    Mark Ericksen
  Date:      04-Oct-2002
  Arguments: AProgram: TProgram; Tree: TTreeView
  Result:    None
  Purpose:   Turn a programs symbols into a browsable TreeView list suitable for
             representing a Tdws2Unit.
-----------------------------------------------------------------------------}
procedure SymbolsToUnitTree(AProgram: TProgram; Tree: TTreeView);
var
  { Nodes that hold sections of items }
  ForwardNode, ConstNode, EnumNode, ArrayNode, RecNode, ClassNode, ProcNode,
  SynonymNode, VarNode: TTreeNode;

  i, x: Integer;
  ForPos,                        // forward
  DeclPos: TSymbolPosition;     // declaration
  PosList,                       // list of symbol positions
  SubSymList: TSymbolPositionList; // sub-Symbol position list (members)
  NewNode: TTreeNode;
begin
  { Requires both the SymbolList and ContextMap compiler directives for the script. }
  Tree.Items.Clear;
  { Create holders up front. Delete empty ones when done. }
  ForwardNode  := CreateNewNode(nil, 'Forwards', imgFolder, Tree, nil);
  ConstNode    := CreateNewNode(nil, 'Constants', imgFolder, Tree, nil);
  EnumNode     := CreateNewNode(nil, 'Enumerations', imgFolder, Tree, nil);
  ArrayNode    := CreateNewNode(nil, 'Arrays', imgFolder, Tree, nil);
  RecNode      := CreateNewNode(nil, 'Records', imgFolder, Tree, nil);
  ClassNode    := CreateNewNode(nil, 'Classes', imgFolder, Tree, nil);
  ProcNode     := CreateNewNode(nil, 'Procedures', imgFolder, Tree, nil);
  SynonymNode  := CreateNewNode(nil, 'Synonyms', imgFolder, Tree, nil);
  VarNode      := CreateNewNode(nil, 'Variables', imgFolder, Tree, nil);

  { Cycle all symbols. Add select types to appropriate categories }
  for i := 0 to AProgram.SymbolDictionary.Count - 1 do
  begin
    PosList := AProgram.SymbolDictionary[i];
    DeclPos := PosList.FindUsage(suDeclaration);     // find where declared
    ForPos  := PosList.FindUsage(suForward);         // find where forwarded (may not be)
    { If found declaration (not in a unit or another script) }
    if Assigned(DeclPos) then
    begin
      { Classes & Forwards - Forwards will be ignored at this point }
      if PosList.Symbol is TClassSymbol then
      begin
        { Add Class forward if applicable }
        if Assigned(ForPos) then
          AddSymbolToTree(ForwardNode, Tree, PosList.Symbol, ForPos);
        { Add Class itself }
        NewNode := AddSymbolToTree(ClassNode, Tree, PosList.Symbol, DeclPos);