dws2ideutils.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 dws2IDEUtils 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.                                              }
{                                                                      }
{    Contributors: Andreas Luleich                                     }
{                                                                      }
{**********************************************************************}

{$I dws2.inc}

unit dws2IDEUtils;

{ Utilities that would be common in an 'advanced' IDE. NOTE: These require
  that the program was compiled with coSymbolDictionary and/or coContextMap }

interface

uses SysUtils, Classes, Graphics,
{$IFDEF NEWVARIANTS}
  Variants,
{$ENDIF}
  dws2Comp, dws2Exprs, dws2Symbols, dws2Errors;

{ Default colors to use for SynEdit style code complete }
var
  clrConst     : TColor = clGreen;     // constant
  clrEnum      : TColor = clGreen;     // enumeration
  clrFunc      : TColor = clBlue;      // function
  clrProc      : TColor = clTeal;      // procedure
  clrConstruct : TColor = clGreen;     // constructor (reused color)
  clrDestruct  : TColor = clRed;       // destructor
  clrProp      : TColor = clNavy;      // property
  clrType      : TColor = clOlive;     // type
  clrAlias     : TColor = clOlive;     // alias (ie. TColor = Integer)
  clrUnit      : TColor = clBlack;     // unit
  clrVar       : TColor = clMaroon;    // variable

{ Default images to use for code hints.
  Assumes following order of images in list:
    0-Unit,     1-Type,      2-Class,    3-ClassField/Variable/Const,
    4-Function, 5-Procedure, 6-Property }
var
  imgFolder    : Integer = 0;          // Folder graphic
  imgType      : Integer = 1;          // type
  imgAlias     : Integer = 1;          // alias (ie. TColor = Integer)
  imgClass     : Integer = 2;          // class
  imgVar       : Integer = 3;          // variable
  imgConst     : Integer = 3;          // Constant
  imgEnum      : Integer = 3;          // Enumeration
  imgFunc      : Integer = 4;          // function
  imgProc      : Integer = 5;          // procedure
  imgConstruct : Integer = 5;          // constructor (reused color)
  imgDestruct  : Integer = 5;          // destructor
  imgProp      : Integer = 6;          // property
  imgUnit      : Integer = 7;          // unit

type
  { The TdSyn_xxx things are using SynEdit specific formating strings }
  TdSyn_DisplayOption = (doSynStyle, doIncludeImage);  // doIncludeImage requires doSynStyle
  TdSyn_DisplayOptions = set of TdSyn_DisplayOption;

  { Content specific options. Separate from SynEdit styling }
  TContentOption = (coIncludeContext, coIncludeUnit{, coDebugValue});
  TContentOptions = set of TContentOption;

{ Helper functions }
function GetImageIndex(ImageIndex: Integer; Include: Boolean): string;
function GetTypeWithColor(AText: string; Color: TColor; UseStyle: Boolean=True): string;
function GetNameWithStyle(AName: string; UseStyle: Boolean=True): string;
procedure LoadClassSymbolToStrings(ItemList, InsertList: TStrings;
             ClassSym: TClassSymbol; IncludeParents, IncludePropertyAccessors: Boolean; ClearLists: Boolean;
             SynOptions: TdSyn_DisplayOptions);
procedure LoadSymbolsToStrings(ItemList, InsertList: TStrings;
             StartingTable: TSymbolTable; LoadUnitSyms, ClearLists,
             IncludePropertyAccessors: Boolean; SynOptions: TdSyn_DisplayOptions;
             AProg: TProgram=nil; ACol: Integer=-1; ALine: Integer=-1);
function  GetSymbolAsText(StartingTable: TSymbolTable; LookupSym: TSymbol;
             SynOptions: TdSyn_DisplayOptions; ContentOpts: TContentOptions): string;
procedure LoadUnitDeclaredSymbols(Prg: TProgram; UnitItemsList, UnitInserts: TStrings;
                                  SynOptions: TdSyn_DisplayOptions;
                                  ContentOptions: TContentOptions=[];
                                  ClearLists: Boolean=True);
// return the property that symbol is used as either a read or write access method
function GetPropertyForSymbol(ASym: TSymbol): TPropertySymbol;
function SymbolIsPropertyRead(AProperty: TPropertySymbol; ASym: TSymbol): Boolean;
function SymbolIsPropertyWrite(AProperty: TPropertySymbol; ASym: TSymbol): Boolean;

// caller is responsible for freeing the TProgram result
function CompileWithSymbolsAndMap(Script: TDelphiWebScriptII; ScriptText: string): TProgram;

// Complete the class defined in the current 'Context'
function CompleteClassAtCursor(Compiler: TDelphiWebScriptII; AProgram: TProgram;
                               CurrentLine, CurrentRow: Integer;
                               ScriptText: TStrings;
                               BareBonesImpl: Boolean=False): Boolean;
// Complete all incomplete classes
function CompleteAllClasses(Compiler: TDelphiWebScriptII;
                            ScriptText: TStrings;
                            BareBonesImpl: Boolean=False): Boolean;
// Complete the passed in class
function CompleteClass(Compiler: TDelphiWebScriptII; AClassName: string; ScriptText: TStrings;
                       BareBonesImpl: Boolean=False): Boolean;

// Create a method implementation. If Barebones, no function result or params are included (still valid)
procedure CreateMethodImpl(Method: TMethodSymbol; InStrings: TStrings; BareBones: Boolean);

// given a line, find the function symbol that is declared or implemented, return symbol
function FindFuncDeclImplOnLine(ALine: Integer; Dictionary: TSymbolDictionary): TSymbolPosition;

// given a symbol's position, find the toggled Decl/Impl position
function FindFuncTogglePosition(Symbol: TSymbol; FromUsages: TSymbolUsages; Dictionary: TSymbolDictionary): TSymbolPosition;

// given a position, return the Function context it is within. If none, returns nil.
function FindFuncContext(ACol, ALine: Integer; ContextMap: TContextMap): TFuncSymbol;

// Return the position in the script for the alternate method declaration or implementation (opposite of current)
function FindToggledFuncDeclImplPos(ACol, ALine: Integer; AProgram: TProgram): TScriptPos;

//// For Ctrl+<hover> Return if it is a symbol that can be jumped to. (for painting)
//function CanFindSymbolDeclaration(ALine, ACol: Integer): Boolean;
//// find the script position of the symbol at the position for the declaration
//function FindDeclarationForSymbol(ALine, ACol: Integer): TScriptPos; overload;
//// find the script position of the symbol for the declaration
//function FindDeclarationForSymbol(Symbol: TSymbol): TScriptPos; overload;

// Return if a symbol's declaration point is prior to the given positon.
function SymbolDeclBeforePos(ACol, ALine: Integer; AProgram: TProgram; ASymbol: TSymbol): Boolean;

{ Minor 'helper' routines }

{ Convert boolean value to str (needed for multiple Delphi versions }
function BoolToStr(Value: Boolean): string;
{ Convert a variant to a string. Puts quotes around a string type. }
function VariantToStr(Value: Variant): string;

implementation

uses dws2Compiler;

{-----------------------------------------------------------------------------
  Procedure: BoolToStr
  Author:    Mark Ericksen
  Date:      24-Mar-2003
  Arguments: Value: Boolean
  Result:    string
  Purpose:   Give easy ability independent of Delphi version to convert a boolean
             value into a string.
-----------------------------------------------------------------------------}
function BoolToStr(Value: Boolean): string;
begin
  if Value then
    Result := 'True'
  else
    Result := 'False';
end;

{-----------------------------------------------------------------------------
  Procedure: VariantToStr
  Author:    Mark Ericksen
  Date:      24-Mar-2003
  Arguments: Value: Variant
  Result:    string
  Purpose:   Convert a variant value to a string. Will add the quotes to string
             types so it is compatible with Delphi and DWS code.
-----------------------------------------------------------------------------}
function VariantToStr(Value: Variant): string;
begin
  if VarIsNull(Value) then
    Result := '<NULL>'
  else if VarIsEmpty(Value) then
    Result := '<Unassigned>'
  else if VarType(Value) = varString then   // NOTE: this is not OLE compatible
    Result := '''' + VarToStr(Value) + ''''
  else if VarType(Value) in [varSmallint..varDate, varBoolean] then
    Result := VarToStr(Value)
  else
    Result := '[other]';
    { TODO : Add support for displaying information about additional types here. }
end;

{-----------------------------------------------------------------------------
  Procedure: CompileWithSymbolsAndMap
  Author:    Mark Ericksen
  Date:      09-Oct-2002
  Arguments: Script: TDelphiWebScriptII; ScriptText: string
  Result:    TProgram
  Purpose:   Compile a script using SymbolDictionary and ContentMap. Restores settings immediately.
-----------------------------------------------------------------------------}
function CompileWithSymbolsAndMap(Script: TDelphiWebScriptII; ScriptText: string): TProgram;
var
  OldOpts : TCompilerOptions;
begin
  // compile the script (store original options, turn on needed options)
  OldOpts := Script.Config.CompilerOptions;
  try
    Script.Config.CompilerOptions := Script.Config.CompilerOptions + [coSymbolDictionary, coContextMap];
    Result := Script.Compile(ScriptText);
  finally
    Script.Config.CompilerOptions := OldOpts;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: GetImageIndex
  Author:    Mark Ericksen
  Date:      03-Oct-2002
  Arguments: ImageIndex: Integer; Include: Boolean; (include text or not)
  Result:    string
  Purpose:   Return the SynCompletionProposal image index for an attached image list.
-----------------------------------------------------------------------------}
function GetImageIndex(ImageIndex: Integer; Include: Boolean): string;
begin
  if Include then
    Result := Format('\image{%d}\column{}', [ImageIndex])  // done as a column
  else
    Result := '';
end;

{-----------------------------------------------------------------------------
  Procedure: GetTypeWithColor
  Author:    Mark Ericksen
  Date:      21-Sep-2002
  Arguments: AText: string; Color: TColor
  Result:    string
  Purpose:   Return the text colored with the desired color.
-----------------------------------------------------------------------------}
function GetTypeWithColor(AText: string; Color: TColor; UseStyle: Boolean): string;
begin
  if UseStyle then
    Result := Format('\color{%s}%s\color{0}', [ColorToString(Color), AText])
  else
    Result := AText;
end;

{-----------------------------------------------------------------------------
  Procedure: GetNameWithStyle
  Author:    Mark Ericksen
  Date:      21-Sep-2002
  Arguments: AName: string
  Result:    string
  Purpose:   Return the provided name as a column that is 'bold toggled'
-----------------------------------------------------------------------------}
function GetNameWithStyle(AName: string; UseStyle: Boolean): string;
begin
  if UseStyle then
    Result := Format('\column{}\style{~B}%s\column{}\style{~B}', [AName])
  else
    Result := AName;
end;

{-----------------------------------------------------------------------------
  Procedure: LoadSymbolsToStrings
  Author:    Mark Ericksen
  Date:      21-Sep-2002
  Arguments: ItemList, InsertList: TStrings; StartingTable: TSymbolTable;
             LoadUnitSyms, ClearLists, IncludePropertyAccessors: Boolean;
             SynOptions: TdSyn_DisplayOptions; AProg: TProgram; ACol, ALine: Integer
  Result:    None
  Purpose:   Return the symbols from the StartingTable and populate the ItemList and InsertList.
             IncludePropertyAccessors - If a properties read and write accessors should be
             included in the list. If false, they are supressed and only the
             property is listed.
             AProg and ACol & ALine are used to limit entries by scope. Don't
             list a symbol that is declared after the cursor's current position.
             If any of them are not provided then they are ignored and all symbols
             are listed.
-----------------------------------------------------------------------------}
procedure LoadSymbolsToStrings(ItemList, InsertList: TStrings;
  StartingTable: TSymbolTable; LoadUnitSyms, ClearLists,