mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-05 18:32:44 +02:00
1435 lines
44 KiB
ObjectPascal
1435 lines
44 KiB
ObjectPascal
{
|
|
***************************************************************************
|
|
* *
|
|
* This source is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
* This code is distributed in the hope that it will be useful, but *
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
|
* General Public License for more details. *
|
|
* *
|
|
* A copy of the GNU General Public License is available on the World *
|
|
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
|
* *
|
|
***************************************************************************
|
|
|
|
Author: Mattias Gaertner
|
|
|
|
Abstract:
|
|
TCodeToolManager gathers all tools in one single Object and makes it easy
|
|
to use the code tools in a program.
|
|
|
|
ToDo:
|
|
|
|
}
|
|
unit CodeToolManager;
|
|
|
|
{$ifdef fpc}{$mode objfpc}{$endif}{$H+}
|
|
|
|
interface
|
|
|
|
{$I codetools.inc}
|
|
|
|
uses
|
|
{$IFDEF MEM_CHECK}
|
|
MemCheck,
|
|
{$ENDIF}
|
|
Classes, SysUtils, CodeCompletionTool, CodeTree, CodeAtom, SourceChanger,
|
|
DefineTemplates, CodeCache, ExprEval, LinkScanner, KeywordFuncLists, TypInfo,
|
|
AVL_Tree, CustomCodeTool, FindDeclarationTool;
|
|
|
|
type
|
|
TCodeToolManager = class;
|
|
|
|
TGetStringProc = procedure(const s: string) of object;
|
|
TOnBeforeApplyChanges = procedure(Manager: TCodeToolManager;
|
|
var Abort: boolean) of object;
|
|
TOnAfterApplyChanges = procedure(Manager: TCodeToolManager) of object;
|
|
|
|
TCodeToolManager = class
|
|
private
|
|
FCatchExceptions: boolean;
|
|
FCheckFilesOnDisk: boolean;
|
|
FCurCodeTool: TCodeCompletionCodeTool; // current codetool
|
|
FCursorBeyondEOL: boolean;
|
|
FErrorCode: TCodeBuffer;
|
|
FErrorColumn: integer;
|
|
FErrorLine: integer;
|
|
FErrorMsg: string;
|
|
FErrorTopLine: integer;
|
|
FIndentSize: integer;
|
|
FJumpCentered: boolean;
|
|
FOnAfterApplyChanges: TOnAfterApplyChanges;
|
|
FOnBeforeApplyChanges: TOnBeforeApplyChanges;
|
|
FSourceExtensions: string; // default is '.pp;.pas;.lpr;.dpr;.dpk'
|
|
FSourceTools: TAVLTree; // tree of TCustomCodeTool
|
|
FVisibleEditorLines: integer;
|
|
FWriteExceptions: boolean;
|
|
function OnScannerGetInitValues(Code: Pointer): TExpressionEvaluator;
|
|
procedure OnDefineTreeReadValue(Sender: TObject; const VariableName: string;
|
|
var Value: string);
|
|
procedure OnGlobalValuesChanged;
|
|
function GetMainCode(Code: TCodeBuffer): TCodeBuffer;
|
|
function InitCurCodeTool(Code: TCodeBuffer): boolean;
|
|
function FindCodeToolForSource(Code: TCodeBuffer): TCustomCodeTool;
|
|
function GetCodeToolForSource(Code: TCodeBuffer;
|
|
ExceptionOnError: boolean): TCustomCodeTool;
|
|
procedure SetCheckFilesOnDisk(NewValue: boolean);
|
|
procedure SetIndentSize(NewValue: integer);
|
|
procedure SetVisibleEditorLines(NewValue: integer);
|
|
procedure SetJumpCentered(NewValue: boolean);
|
|
procedure SetCursorBeyondEOL(NewValue: boolean);
|
|
procedure BeforeApplyingChanges(var Abort: boolean);
|
|
procedure AfterApplyingChanges;
|
|
function HandleException(AnException: Exception): boolean;
|
|
function OnGetCodeToolForBuffer(Sender: TObject;
|
|
Code: TCodeBuffer): TFindDeclarationTool;
|
|
public
|
|
DefinePool: TDefinePool; // definition templates (rules)
|
|
DefineTree: TDefineTree; // cache for defines (e.g. initial compiler values)
|
|
SourceCache: TCodeCache; // cache for source (units, include files, ...)
|
|
SourceChangeCache: TSourceChangeCache; // cache for write accesses
|
|
GlobalValues: TExpressionEvaluator;
|
|
|
|
// Write Lock
|
|
procedure BeginUpdate;
|
|
procedure EndUpdate;
|
|
|
|
// file handling
|
|
property SourceExtensions: string
|
|
read FSourceExtensions write FSourceExtensions;
|
|
function FindFile(const ExpandedFilename: string): TCodeBuffer;
|
|
function LoadFile(const ExpandedFilename: string;
|
|
UpdateFromDisk, Revert: boolean): TCodeBuffer;
|
|
function CreateFile(const AFilename: string): TCodeBuffer;
|
|
function SaveBufferAs(OldBuffer: TCodeBuffer;const ExpandedFilename: string;
|
|
var NewBuffer: TCodeBuffer): boolean;
|
|
function FilenameHasSourceExt(const ExpandedFilename: string): boolean;
|
|
|
|
// exception handling
|
|
property CatchExceptions: boolean
|
|
read FCatchExceptions write FCatchExceptions;
|
|
property WriteExceptions: boolean
|
|
read FWriteExceptions write FWriteExceptions;
|
|
property ErrorCode: TCodeBuffer read fErrorCode;
|
|
property ErrorColumn: integer read fErrorColumn;
|
|
property ErrorLine: integer read fErrorLine;
|
|
property ErrorMessage: string read fErrorMsg;
|
|
property ErrorTopLine: integer read fErrorTopLine;
|
|
|
|
// tool settings
|
|
property CheckFilesOnDisk: boolean
|
|
read FCheckFilesOnDisk write SetCheckFilesOnDisk;
|
|
property IndentSize: integer read FIndentSize write SetIndentSize;
|
|
property VisibleEditorLines: integer
|
|
read FVisibleEditorLines write SetVisibleEditorLines;
|
|
property JumpCentered: boolean read FJumpCentered write SetJumpCentered;
|
|
property CursorBeyondEOL: boolean
|
|
read FCursorBeyondEOL write SetCursorBeyondEOL;
|
|
|
|
// events
|
|
property OnBeforeApplyChanges: TOnBeforeApplyChanges
|
|
read FOnBeforeApplyChanges write FOnBeforeApplyChanges;
|
|
property OnAfterApplyChanges: TOnAfterApplyChanges
|
|
read FOnAfterApplyChanges write FOnAfterApplyChanges;
|
|
|
|
// syntax checking (true on syntax is ok)
|
|
function CheckSyntax(Code: TCodeBuffer; var NewCode: TCodeBuffer;
|
|
var NewX, NewY, NewTopLine: integer; var ErrorMsg: string): boolean;
|
|
|
|
// method jumping
|
|
function JumpToMethod(Code: TCodeBuffer; X,Y: integer;
|
|
var NewCode: TCodeBuffer;
|
|
var NewX, NewY, NewTopLine: integer): boolean;
|
|
|
|
// blocks (e.g. begin..end, case..end, try..finally..end, repeat..until)
|
|
function FindBlockCounterPart(Code: TCodeBuffer; X,Y: integer;
|
|
var NewCode: TCodeBuffer;
|
|
var NewX, NewY, NewTopLine: integer): boolean;
|
|
function FindBlockStart(Code: TCodeBuffer; X,Y: integer;
|
|
var NewCode: TCodeBuffer;
|
|
var NewX, NewY, NewTopLine: integer): boolean;
|
|
function GuessUnclosedBlock(Code: TCodeBuffer; X,Y: integer;
|
|
var NewCode: TCodeBuffer;
|
|
var NewX, NewY, NewTopLine: integer): boolean;
|
|
|
|
|
|
// find declaration
|
|
function FindDeclaration(Code: TCodeBuffer; X,Y: integer;
|
|
var NewCode: TCodeBuffer;
|
|
var NewX, NewY, NewTopLine: integer): boolean;
|
|
|
|
// functions for events in the object inspector
|
|
procedure GetCompatibleMethods(Code: TCodeBuffer; const AClassName: string;
|
|
TypeData: PTypeData; Proc: TGetStringProc);
|
|
function MethodExists(Code:TCodeBuffer; const AClassName,
|
|
AMethodName: string; TypeData: PTypeData): boolean;
|
|
function JumpToMethodBody(Code: TCodeBuffer;
|
|
const AClassName, AMethodName: string; TypeData: PTypeData;
|
|
var NewCode: TCodeBuffer;
|
|
var NewX, NewY, NewTopLine: integer): boolean;
|
|
function RenameMethod(Code: TCodeBuffer; const AClassName, OldMethodName,
|
|
NewMethodName: string; TypeData: PTypeData): boolean;
|
|
function CreateMethod(Code: TCodeBuffer; const AClassName,
|
|
NewMethodName: string; TypeData: PTypeData): boolean;
|
|
|
|
// code completion = auto class completion, auto forward proc completion
|
|
function CompleteCode(Code: TCodeBuffer; X,Y: integer;
|
|
var NewCode: TCodeBuffer;
|
|
var NewX, NewY, NewTopLine: integer): boolean;
|
|
|
|
// source name e.g. 'unit UnitName;'
|
|
function GetSourceName(Code: TCodeBuffer): string;
|
|
function RenameSource(Code: TCodeBuffer; const NewName: string): boolean;
|
|
function GetSourceType(Code: TCodeBuffer): string;
|
|
|
|
// uses sections
|
|
function FindUnitInAllUsesSections(Code: TCodeBuffer;
|
|
const AnUnitName: string;
|
|
var NamePos, InPos: integer): boolean;
|
|
function RenameUsedUnit(Code: TCodeBuffer;
|
|
const OldUnitName, NewUnitName, NewUnitInFile: string): boolean;
|
|
function AddUnitToMainUsesSection(Code: TCodeBuffer;
|
|
const NewUnitName, NewUnitInFile: string): boolean;
|
|
function RemoveUnitFromAllUsesSections(Code: TCodeBuffer;
|
|
const AnUnitName: string): boolean;
|
|
|
|
// resources
|
|
function FindLFMFileName(Code: TCodeBuffer): string;
|
|
function FindNextResourceFile(Code: TCodeBuffer;
|
|
var LinkIndex: integer): TCodeBuffer;
|
|
function FindLazarusResource(Code: TCodeBuffer;
|
|
const ResourceName: string): TAtomPosition;
|
|
function AddLazarusResource(Code: TCodeBuffer;
|
|
const ResourceName, ResourceData: string): boolean;
|
|
function RemoveLazarusResource(Code: TCodeBuffer;
|
|
const ResourceName: string): boolean;
|
|
function RenameMainInclude(Code: TCodeBuffer; const NewFilename: string;
|
|
KeepPath: boolean): boolean;
|
|
|
|
// Application.Createform(ClassName,VarName) statements in program source
|
|
function FindCreateFormStatement(Code: TCodeBuffer; StartPos: integer;
|
|
const AClassName, AVarName: string;
|
|
var Position: integer): integer; // 0=found, -1=not found, 1=found, but wrong classname
|
|
function AddCreateFormStatement(Code: TCodeBuffer;
|
|
const AClassName, AVarName: string): boolean;
|
|
function RemoveCreateFormStatement(Code: TCodeBuffer;
|
|
const AVarName: string): boolean;
|
|
function ListAllCreateFormStatements(Code: TCodeBuffer): TStrings;
|
|
function SetAllCreateFromStatements(Code: TCodeBuffer;
|
|
List: TStrings): boolean;
|
|
|
|
// form components
|
|
function PublishedVariableExists(Code: TCodeBuffer;
|
|
const AClassName, AVarName: string): boolean;
|
|
function AddPublishedVariable(Code: TCodeBuffer;
|
|
const AClassName,VarName, VarType: string): boolean;
|
|
function RemovePublishedVariable(Code: TCodeBuffer;
|
|
const AClassName, AVarName: string): boolean;
|
|
|
|
|
|
function ApplyChanges: boolean;
|
|
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
|
|
function ConsistencyCheck: integer; // 0 = ok
|
|
procedure WriteDebugReport(WriteTool,
|
|
WriteDefPool, WriteDefTree, WriteCache, WriteGlobalValues: boolean);
|
|
end;
|
|
|
|
|
|
var CodeToolBoss: TCodeToolManager;
|
|
|
|
|
|
|
|
implementation
|
|
|
|
|
|
function CompareCodeToolMainSources(Data1, Data2: Pointer): integer;
|
|
var
|
|
Src1, Src2: integer;
|
|
begin
|
|
Src1:=Integer(TCustomCodeTool(Data1).Scanner.MainCode);
|
|
Src2:=Integer(TCustomCodeTool(Data2).Scanner.MainCode);
|
|
if Src1<Src2 then
|
|
Result:=-1
|
|
else if Src1>Src2 then
|
|
Result:=+1
|
|
else
|
|
Result:=0;
|
|
end;
|
|
|
|
|
|
{ TCodeToolManager }
|
|
|
|
constructor TCodeToolManager.Create;
|
|
begin
|
|
inherited Create;
|
|
FCheckFilesOnDisk:=true;
|
|
DefineTree:=TDefineTree.Create;
|
|
DefineTree.OnReadValue:=@OnDefineTreeReadValue;
|
|
DefinePool:=TDefinePool.Create;
|
|
SourceCache:=TCodeCache.Create;
|
|
SourceChangeCache:=TSourceChangeCache.Create;
|
|
SourceChangeCache.OnBeforeApplyChanges:=@BeforeApplyingChanges;
|
|
SourceChangeCache.OnAfterApplyChanges:=@AfterApplyingChanges;
|
|
GlobalValues:=TExpressionEvaluator.Create;
|
|
FSourceExtensions:='.pp;.pas;.lpr;.dpr;.dpk';
|
|
FCatchExceptions:=true;
|
|
FWriteExceptions:=true;
|
|
FIndentSize:=2;
|
|
FVisibleEditorLines:=20;
|
|
FJumpCentered:=true;
|
|
FCursorBeyondEOL:=true;
|
|
FSourceTools:=TAVLTree.Create(@CompareCodeToolMainSources);
|
|
end;
|
|
|
|
destructor TCodeToolManager.Destroy;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TCodeToolManager.Destroy] A');
|
|
{$ENDIF}
|
|
GlobalValues.Free;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TCodeToolManager.Destroy] B');
|
|
{$ENDIF}
|
|
FSourceTools.FreeAndClear;
|
|
FSourceTools.Free;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TCodeToolManager.Destroy] C');
|
|
{$ENDIF}
|
|
DefineTree.Free;
|
|
DefinePool.Free;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TCodeToolManager.Destroy] D');
|
|
{$ENDIF}
|
|
SourceChangeCache.Free;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TCodeToolManager.Destroy] E');
|
|
{$ENDIF}
|
|
SourceCache.Free;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TCodeToolManager.Destroy] F');
|
|
{$ENDIF}
|
|
inherited Destroy;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TCodeToolManager.Destroy] END');
|
|
{$ENDIF}
|
|
{$IFDEF MEM_CHECK}
|
|
CheckHeap('TCodeToolManager.Destroy END');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCodeToolManager.BeginUpdate;
|
|
begin
|
|
SourceChangeCache.BeginUpdate;
|
|
end;
|
|
|
|
procedure TCodeToolManager.EndUpdate;
|
|
begin
|
|
SourceChangeCache.EndUpdate;
|
|
end;
|
|
|
|
function TCodeToolManager.FindFile(const ExpandedFilename: string): TCodeBuffer;
|
|
begin
|
|
Result:=SourceCache.FindFile(ExpandedFilename);
|
|
end;
|
|
|
|
function TCodeToolManager.LoadFile(const ExpandedFilename: string;
|
|
UpdateFromDisk, Revert: boolean): TCodeBuffer;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
writeln('>>>>>> [TCodeToolManager.LoadFile] ',ExpandedFilename,' Update=',UpdateFromDisk,' Revert=',Revert);
|
|
{$ENDIF}
|
|
Result:=SourceCache.LoadFile(ExpandedFilename);
|
|
if Result<>nil then begin
|
|
if Revert then
|
|
Result.Revert
|
|
else if UpdateFromDisk then
|
|
Result.Reload;
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.CreateFile(const AFilename: string): TCodeBuffer;
|
|
begin
|
|
Result:=SourceCache.CreateFile(AFilename);
|
|
{$IFDEF CTDEBUG}
|
|
writeln('****** TCodeToolManager.CreateFile "',AFilename,'" ',Result<>nil);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.SaveBufferAs(OldBuffer: TCodeBuffer;
|
|
const ExpandedFilename: string; var NewBuffer: TCodeBuffer): boolean;
|
|
begin
|
|
Result:=SourceCache.SaveBufferAs(OldBuffer,ExpandedFilename,NewBuffer);
|
|
end;
|
|
|
|
function TCodeToolManager.FilenameHasSourceExt(
|
|
const ExpandedFilename: string): boolean;
|
|
var i, CurExtStart, CurExtEnd, ExtStart, ExtLen: integer;
|
|
begin
|
|
ExtStart:=length(ExpandedFilename);
|
|
while (ExtStart>0) and (ExpandedFilename[ExtStart]<>'.')
|
|
and (ExpandedFilename[ExtStart]<>PathDelim) do
|
|
dec(ExtStart);
|
|
if (ExtStart<1) or (ExpandedFilename[ExtStart]<>'.') then begin
|
|
Result:=false;
|
|
exit;
|
|
end;
|
|
ExtLen:=length(ExpandedFilename)-ExtStart+1;
|
|
CurExtStart:=1;
|
|
CurExtEnd:=CurExtStart;
|
|
while CurExtEnd<=length(FSourceExtensions)+1 do begin
|
|
if (CurExtEnd>length(FSourceExtensions))
|
|
or (FSourceExtensions[CurExtEnd] in [':',';']) then begin
|
|
// compare current extension with filename-extension
|
|
if ExtLen=CurExtEnd-CurExtStart then begin
|
|
i:=0;
|
|
while (i<ExtLen)
|
|
and (UpChars[ExpandedFilename[i+ExtStart]]
|
|
=UpChars[FSourceExtensions[CurExtStart+i]]) do
|
|
inc(i);
|
|
if i=ExtLen then begin
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
inc(CurExtEnd);
|
|
CurExtStart:=CurExtEnd;
|
|
end else
|
|
inc(CurExtEnd);
|
|
end;
|
|
Result:=false;
|
|
end;
|
|
|
|
function TCodeToolManager.GetMainCode(Code: TCodeBuffer): TCodeBuffer;
|
|
begin
|
|
// find MainCode (= the start source, e.g. a unit/program/package source)
|
|
Result:=Code;
|
|
if Result=nil then exit;
|
|
while (not FilenameHasSourceExt(Result.Filename)) do begin
|
|
// source is no begin of unit/program/package
|
|
// perhaps it is included by another source
|
|
if Result.LastIncludedByFile<>'' then begin
|
|
// source is included
|
|
Result:=SourceCache.LoadFile(Result.LastIncludedByFile);
|
|
if Result=nil then exit;
|
|
end else begin
|
|
// source was never parsed
|
|
exit;
|
|
end;
|
|
end;
|
|
if FilenameHasSourceExt(Result.Filename) and (Result.Scanner=nil) then begin
|
|
// create a scanner for the unit/program
|
|
Result.Scanner:=TLinkScanner.Create;
|
|
Result.Scanner.OnGetInitValues:=@OnScannerGetInitValues;
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.ApplyChanges: boolean;
|
|
begin
|
|
Result:=SourceChangeCache.Apply;
|
|
end;
|
|
|
|
function TCodeToolManager.InitCurCodeTool(Code: TCodeBuffer): boolean;
|
|
var MainCode: TCodeBuffer;
|
|
begin
|
|
Result:=false;
|
|
fErrorMsg:='';
|
|
fErrorCode:=nil;
|
|
fErrorLine:=-1;
|
|
MainCode:=GetMainCode(Code);
|
|
if MainCode=nil then begin
|
|
fErrorMsg:='TCodeToolManager.InitCurCodeTool MainCode=nil';
|
|
exit;
|
|
end;
|
|
FCurCodeTool:=TCodeCompletionCodeTool(GetCodeToolForSource(MainCode,true));
|
|
FCurCodeTool.ErrorPosition.Code:=nil;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TCodeToolManager.InitCurCodeTool] ',Code.Filename,' ',Code.SourceLength);
|
|
{$ENDIF}
|
|
Result:=(FCurCodeTool.Scanner<>nil);
|
|
if not Result then begin
|
|
fErrorCode:=MainCode;
|
|
fErrorMsg:='No scanner available';
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.HandleException(AnException: Exception): boolean;
|
|
var ErrorSrcTool: TCustomCodeTool;
|
|
begin
|
|
fErrorMsg:=AnException.Message;
|
|
if (AnException is ELinkScannerError)
|
|
and (FCurCodeTool<>nil) and (FCurCodeTool.Scanner<>nil)
|
|
and (FCurCodeTool.Scanner.Code<>nil)
|
|
and (FCurCodeTool.Scanner.LinkCount>0) then begin
|
|
fErrorCode:=TCodeBuffer(FCurCodeTool.Scanner.Code);
|
|
if fErrorCode<>nil then
|
|
fErrorCode.AbsoluteToLineCol(
|
|
FCurCodeTool.Scanner.SrcPos,fErrorLine,fErrorColumn);
|
|
end else if (AnException is ECodeToolError) then begin
|
|
ErrorSrcTool:=ECodeToolError(AnException).Sender;
|
|
fErrorCode:=ErrorSrcTool.ErrorPosition.Code;
|
|
fErrorColumn:=ErrorSrcTool.ErrorPosition.X;
|
|
fErrorLine:=ErrorSrcTool.ErrorPosition.Y;
|
|
fErrorTopLine:=fErrorLine;
|
|
if JumpCentered then begin
|
|
dec(fErrorTopLine,VisibleEditorLines div 2);
|
|
if fErrorTopLine<1 then fErrorTopLine:=1;
|
|
end;
|
|
end else if FCurCodeTool<>nil then begin
|
|
fErrorCode:=FCurCodeTool.ErrorPosition.Code;
|
|
fErrorColumn:=FCurCodeTool.ErrorPosition.X;
|
|
fErrorLine:=FCurCodeTool.ErrorPosition.Y;
|
|
fErrorTopLine:=fErrorLine;
|
|
if JumpCentered then begin
|
|
dec(fErrorTopLine,VisibleEditorLines div 2);
|
|
if fErrorTopLine<1 then fErrorTopLine:=1;
|
|
end;
|
|
end;
|
|
if FWriteExceptions then begin
|
|
{$IFDEF CTDEBUG}
|
|
WriteDebugReport(true,false,false,false,false);
|
|
{$ENDIF}
|
|
write('### TCodeToolManager.HandleException: "'+ErrorMessage+'"');
|
|
if ErrorLine>0 then write(' at Line=',ErrorLine);
|
|
if ErrorColumn>0 then write(' Col=',ErrorColumn);
|
|
if ErrorCode<>nil then write(' in "',ErrorCode.Filename,'"');
|
|
writeln('');
|
|
end;
|
|
if not FCatchExceptions then raise AnException;
|
|
Result:=false;
|
|
end;
|
|
|
|
function TCodeToolManager.CheckSyntax(Code: TCodeBuffer;
|
|
var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer;
|
|
var ErrorMsg: string): boolean;
|
|
// returns true on syntax correct
|
|
begin
|
|
Result:=false;
|
|
try
|
|
if InitCurCodeTool(Code) then begin
|
|
FCurCodeTool.BuildTree(false);
|
|
Result:=true;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
NewCode:=ErrorCode;
|
|
NewX:=ErrorColumn;
|
|
NewY:=ErrorLine;
|
|
NewTopLine:=ErrorTopLine;
|
|
ErrorMsg:=ErrorMessage;
|
|
end;
|
|
|
|
function TCodeToolManager.JumpToMethod(Code: TCodeBuffer; X,Y: integer;
|
|
var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.JumpToMethod A ',Code.Filename,' x=',x,' y=',y);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.JumpToMethod B ',FCurCodeTool.Scanner<>nil);
|
|
{$ENDIF}
|
|
try
|
|
Result:=FCurCodeTool.FindJumpPoint(CursorPos,NewPos,NewTopLine);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.JumpToMethod END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.FindDeclaration(Code: TCodeBuffer; X,Y: integer;
|
|
var NewCode: TCodeBuffer;
|
|
var NewX, NewY, NewTopLine: integer): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.FindDeclaration A ',Code.Filename,' x=',x,' y=',y);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.FindDeclaration B ',FCurCodeTool.Scanner<>nil);
|
|
{$ENDIF}
|
|
try
|
|
Result:=FCurCodeTool.FindDeclaration(CursorPos,NewPos,NewTopLine);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.FindDeclaration END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.FindBlockCounterPart(Code: TCodeBuffer;
|
|
X, Y: integer; var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer
|
|
): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.FindBlockCounterPart A ',Code.Filename,' x=',x,' y=',y);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.FindBlockCounterPart B ',FCurCodeTool.Scanner<>nil);
|
|
{$ENDIF}
|
|
try
|
|
Result:=FCurCodeTool.FindBlockCounterPart(CursorPos,NewPos,NewTopLine);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.FindBlockCounterPart END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.FindBlockStart(Code: TCodeBuffer;
|
|
X, Y: integer; var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer
|
|
): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.FindBlockStart A ',Code.Filename,' x=',x,' y=',y);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.FindBlockStart B ',FCurCodeTool.Scanner<>nil);
|
|
{$ENDIF}
|
|
try
|
|
Result:=FCurCodeTool.FindBlockStart(CursorPos,NewPos,NewTopLine);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.FindBlockStart END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.GuessUnclosedBlock(Code: TCodeBuffer; X, Y: integer;
|
|
var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.GuessUnclosedBlock A ',Code.Filename,' x=',x,' y=',y);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.GuessUnclosedBlock B ',FCurCodeTool.Scanner<>nil);
|
|
{$ENDIF}
|
|
try
|
|
Result:=FCurCodeTool.GuessUnclosedBlock(CursorPos,NewPos,NewTopLine);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.GuessUnclosedBlock END ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCodeToolManager.GetCompatibleMethods(Code: TCodeBuffer;
|
|
const AClassName: string; TypeData: PTypeData; Proc: TGetStringProc);
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.GetCompatibleMethods A ',Code.Filename,' Classname=',AClassname);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
FCurCodeTool.GetCompatiblePublishedMethods(UpperCaseStr(AClassName),
|
|
TypeData,Proc);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.MethodExists(Code:TCodeBuffer;
|
|
const AClassName, AMethodName: string; TypeData: PTypeData): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.MethodExists A ',Code.Filename,' ',AClassName,':',AMethodName);
|
|
{$ENDIF}
|
|
Result:=InitCurCodeTool(Code);
|
|
if not Result then exit;
|
|
try
|
|
Result:=FCurCodeTool.PublishedMethodExists(UpperCaseStr(AClassName),
|
|
UpperCaseStr(AMethodName),TypeData);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.JumpToMethodBody(Code: TCodeBuffer;
|
|
const AClassName, AMethodName: string; TypeData: PTypeData;
|
|
var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer): boolean;
|
|
var NewPos: TCodeXYPosition;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.JumpToMethodBody A ',Code.Filename,' ',AClassName,':',AMethodName);
|
|
{$ENDIF}
|
|
Result:=InitCurCodeTool(Code);
|
|
if not Result then exit;
|
|
try
|
|
Result:=FCurCodeTool.JumpToPublishedMethodBody(UpperCaseStr(AClassName),
|
|
UpperCaseStr(AMethodName),TypeData,NewPos,NewTopLine);
|
|
if Result then begin
|
|
NewCode:=NewPos.Code;
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RenameMethod(Code: TCodeBuffer; const AClassName,
|
|
OldMethodName, NewMethodName: string; TypeData: PTypeData): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.RenameMethod A');
|
|
{$ENDIF}
|
|
Result:=InitCurCodeTool(Code);
|
|
if not Result then exit;
|
|
try
|
|
SourceChangeCache.Clear;
|
|
Result:=FCurCodeTool.RenamePublishedMethod(UpperCaseStr(AClassName),
|
|
UpperCaseStr(OldMethodName),NewMethodName,TypeData,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.CreateMethod(Code: TCodeBuffer; const AClassName,
|
|
NewMethodName: string; TypeData: PTypeData): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.CreateMethod A');
|
|
{$ENDIF}
|
|
Result:=InitCurCodeTool(Code);
|
|
if not Result then exit;
|
|
try
|
|
SourceChangeCache.Clear;
|
|
Result:=FCurCodeTool.CreatePublishedMethod(UpperCaseStr(AClassName),
|
|
NewMethodName,TypeData,SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.CompleteCode(Code: TCodeBuffer; X,Y: integer;
|
|
var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer): boolean;
|
|
var
|
|
CursorPos: TCodeXYPosition;
|
|
NewPos: TCodeXYPosition;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.CompleteCode A ',Code.Filename,' x=',x,' y=',y);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
if not InitCurCodeTool(Code) then exit;
|
|
CursorPos.X:=X;
|
|
CursorPos.Y:=Y;
|
|
CursorPos.Code:=Code;
|
|
try
|
|
Result:=FCurCodeTool.CompleteCode(CursorPos,NewPos,NewTopLine,SourceChangeCache);
|
|
if Result then begin
|
|
NewX:=NewPos.X;
|
|
NewY:=NewPos.Y;
|
|
NewCode:=NewPos.Code;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.GetSourceName(Code: TCodeBuffer): string;
|
|
begin
|
|
Result:='';
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.GetSourceName A ',Code.Filename,' ',Code.SourceLength);
|
|
{$ENDIF}
|
|
{$IFDEF MEM_CHECK}
|
|
CheckHeap(IntToStr(GetMem_Cnt));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.GetSourceName;
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.GetSourceName B ',Code.Filename,' ',Code.SourceLength);
|
|
{$IFDEF MEM_CHECK}
|
|
CheckHeap(IntToStr(GetMem_Cnt));
|
|
{$ENDIF}
|
|
writeln('SourceName=',Result);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.GetSourceType(Code: TCodeBuffer): string;
|
|
begin
|
|
Result:='';
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.GetSourceType A ',Code.Filename,' ',Code.SourceLength);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
// GetSourceType does not parse the code -> parse it with GetSourceName
|
|
FCurCodeTool.GetSourceName;
|
|
case FCurCodeTool.GetSourceType of
|
|
ctnProgram: Result:='PROGRAM';
|
|
ctnPackage: Result:='PACKAGE';
|
|
ctnLibrary: Result:='LIBRARY';
|
|
ctnUnit: Result:='UNIT';
|
|
else
|
|
Result:='';
|
|
end;
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.GetSourceType END ',Code.Filename,',',Code.SourceLength);
|
|
{$IFDEF MEM_CHECK}
|
|
CheckHeap(IntToStr(GetMem_Cnt));
|
|
{$ENDIF}
|
|
writeln('SourceType=',Result);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCodeToolManager.RenameSource(Code: TCodeBuffer;
|
|
const NewName: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.RenameSource A ',Code.Filename,' NewName=',NewName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.RenameSource(NewName,SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindUnitInAllUsesSections(Code: TCodeBuffer;
|
|
const AnUnitName: string;
|
|
var NamePos, InPos: integer): boolean;
|
|
var NameAtomPos, InAtomPos: TAtomPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.FindUnitInAllUsesSections A ',Code.Filename,' UnitName=',AnUnitName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.FindUnitInAllUsesSections B ',Code.Filename,' UnitName=',AnUnitName);
|
|
{$ENDIF}
|
|
try
|
|
Result:=FCurCodeTool.FindUnitInAllUsesSections(UpperCaseStr(AnUnitName),
|
|
NameAtomPos, InAtomPos);
|
|
if Result then begin
|
|
NamePos:=NameAtomPos.StartPos;
|
|
InPos:=InAtomPos.StartPos;
|
|
end;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RenameUsedUnit(Code: TCodeBuffer;
|
|
const OldUnitName, NewUnitName, NewUnitInFile: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.RenameUsedUnit A, ',Code.Filename,' Old=',OldUnitName,' New=',NewUnitName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.RenameUsedUnit(UpperCaseStr(OldUnitName),NewUnitName,
|
|
NewUnitInFile,SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.AddUnitToMainUsesSection(Code: TCodeBuffer;
|
|
const NewUnitName, NewUnitInFile: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.AddUnitToMainUsesSection A ',Code.Filename,' NewUnitName=',NewUnitName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.AddUnitToMainUsesSection(NewUnitName, NewUnitInFile,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RemoveUnitFromAllUsesSections(Code: TCodeBuffer;
|
|
const AnUnitName: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.RemoveUnitFromAllUsesSections A ',Code.Filename,' UnitName=',AnUnitName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.RemoveUnitFromAllUsesSections(UpperCaseStr(AnUnitName),
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindLFMFileName(Code: TCodeBuffer): string;
|
|
var LinkIndex: integer;
|
|
CurCode: TCodeBuffer;
|
|
Ext: string;
|
|
begin
|
|
Result:='';
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.FindLFMFileName A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
LinkIndex:=-1;
|
|
CurCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
|
|
while (CurCode<>nil) do begin
|
|
if UpperCaseStr(ExtractFileExt(CurCode.Filename))='.LRS' then begin
|
|
Result:=CurCode.Filename;
|
|
Ext:=ExtractFileExt(Result);
|
|
Result:=copy(Result,1,length(Result)-length(Ext))+'.lfm';
|
|
exit;
|
|
end;
|
|
CurCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
|
|
end;
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindNextResourceFile(Code: TCodeBuffer;
|
|
var LinkIndex: integer): TCodeBuffer;
|
|
begin
|
|
Result:=nil;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.FindNextResourceFile A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindLazarusResource(Code: TCodeBuffer;
|
|
const ResourceName: string): TAtomPosition;
|
|
begin
|
|
Result.StartPos:=-1;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.FindLazarusResource A ',Code.Filename,' ResourceName=',ResourceName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindLazarusResource(ResourceName);
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.AddLazarusResource(Code: TCodeBuffer;
|
|
const ResourceName, ResourceData: string): boolean;
|
|
var ResCode: TCodeBuffer;
|
|
LinkIndex: integer;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.AddLazarusResource A ',Code.Filename,' ResourceName=',ResourceName,' ',length(ResourceData));
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.AddLazarusResource B ');
|
|
{$ENDIF}
|
|
try
|
|
LinkIndex:=-1;
|
|
ResCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
|
|
if ResCode=nil then exit;
|
|
Result:=FCurCodeTool.AddLazarusResource(Rescode,ResourceName,ResourceData,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RemoveLazarusResource(Code: TCodeBuffer;
|
|
const ResourceName: string): boolean;
|
|
var ResCode: TCodeBuffer;
|
|
LinkIndex: integer;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.RemoveLazarusResource A ',Code.Filename,' ResourceName=',ResourceName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
LinkIndex:=-1;
|
|
ResCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
|
|
if ResCode=nil then exit;
|
|
Result:=FCurCodeTool.RemoveLazarusResource(ResCode,ResourceName,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RenameMainInclude(Code: TCodeBuffer;
|
|
const NewFilename: string; KeepPath: boolean): boolean;
|
|
var LinkIndex: integer;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.RenameMainInclude A ',Code.Filename,' NewFilename=',NewFilename,' KeepPath=',KeepPath);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
LinkIndex:=-1;
|
|
if FCurCodeTool.FindNextIncludeInInitialization(LinkIndex)=nil then exit;
|
|
Result:=FCurCodeTool.RenameInclude(LinkIndex,NewFilename,KeepPath,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.FindCreateFormStatement(Code: TCodeBuffer;
|
|
StartPos: integer;
|
|
const AClassName, AVarName: string;
|
|
var Position: integer): integer;
|
|
// 0=found, -1=not found, 1=found, but wrong classname
|
|
var PosAtom: TAtomPosition;
|
|
begin
|
|
Result:=-1;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.FindCreateFormStatement A ',Code.Filename,' StartPos=',StartPos,' ',AClassName,':',AVarName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindCreateFormStatement(StartPos,UpperCaseStr(AClassName),
|
|
UpperCaseStr(AVarName),PosAtom);
|
|
if Result<>-1 then
|
|
Position:=PosAtom.StartPos;
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.AddCreateFormStatement(Code: TCodeBuffer;
|
|
const AClassName, AVarName: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.AddCreateFormStatement A ',Code.Filename,' ',AClassName,':',AVarName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.AddCreateFormStatement(AClassName,AVarName,
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RemoveCreateFormStatement(Code: TCodeBuffer;
|
|
const AVarName: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.RemoveCreateFormStatement A ',Code.Filename,' ',AVarName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.RemoveCreateFormStatement(UpperCaseStr(AVarName),
|
|
SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.ListAllCreateFormStatements(
|
|
Code: TCodeBuffer): TStrings;
|
|
begin
|
|
Result:=nil;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.ListAllCreateFormStatements A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.ListAllCreateFormStatements;
|
|
except
|
|
on e: Exception do HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.SetAllCreateFromStatements(Code: TCodeBuffer;
|
|
List: TStrings): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.SetAllCreateFromStatements A ',Code.Filename);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.SetAllCreateFromStatements(List,SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.PublishedVariableExists(Code: TCodeBuffer;
|
|
const AClassName, AVarName: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.PublishedVariableExists A ',Code.Filename,' ',AClassName,':',AVarName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.FindPublishedVariable(UpperCaseStr(AClassName),
|
|
UpperCaseStr(AVarName))<>nil;
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.AddPublishedVariable(Code: TCodeBuffer;
|
|
const AClassName, VarName, VarType: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.AddPublishedVariable A ',Code.Filename,' ',AClassName,':',VarName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.AddPublishedVariable(UpperCaseStr(AClassName),
|
|
VarName,VarType,SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.RemovePublishedVariable(Code: TCodeBuffer;
|
|
const AClassName, AVarName: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TCodeToolManager.RemovePublishedVariable A ',Code.Filename,' ',AClassName,':',AVarName);
|
|
{$ENDIF}
|
|
if not InitCurCodeTool(Code) then exit;
|
|
try
|
|
Result:=FCurCodeTool.RemovePublishedVariable(UpperCaseStr(AClassName),
|
|
UpperCaseStr(AVarName),SourceChangeCache);
|
|
except
|
|
on e: Exception do Result:=HandleException(e);
|
|
end;
|
|
end;
|
|
|
|
function TCodeToolManager.OnScannerGetInitValues(
|
|
Code: Pointer): TExpressionEvaluator;
|
|
begin
|
|
Result:=nil;
|
|
if Code=nil then exit;
|
|
//DefineTree.WriteDebugReport;
|
|
if not TCodeBuffer(Code).IsVirtual then
|
|
Result:=DefineTree.GetDefinesForDirectory(
|
|
ExtractFilePath(TCodeBuffer(Code).Filename))
|
|
else
|
|
Result:=DefineTree.GetDefinesForVirtualDirectory;
|
|
end;
|
|
|
|
procedure TCodeToolManager.OnDefineTreeReadValue(Sender: TObject;
|
|
const VariableName: string; var Value: string);
|
|
begin
|
|
Value:=GlobalValues[VariableName];
|
|
//writeln('[TCodeToolManager.OnDefineTreeReadValue] Name="',VariableName,'" = "',Value,'"');
|
|
end;
|
|
|
|
procedure TCodeToolManager.OnGlobalValuesChanged;
|
|
begin
|
|
DefineTree.ClearCache;
|
|
end;
|
|
|
|
procedure TCodeToolManager.SetCheckFilesOnDisk(NewValue: boolean);
|
|
begin
|
|
if NewValue=FCheckFilesOnDisk then exit;
|
|
FCheckFilesOnDisk:=NewValue;
|
|
if FCurCodeTool<>nil then
|
|
FCurCodeTool.CheckFilesOnDisk:=NewValue;
|
|
end;
|
|
|
|
procedure TCodeToolManager.SetIndentSize(NewValue: integer);
|
|
begin
|
|
if NewValue=FIndentSize then exit;
|
|
FIndentSize:=NewValue;
|
|
if FCurCodeTool<>nil then
|
|
FCurCodeTool.IndentSize:=NewValue;
|
|
end;
|
|
|
|
procedure TCodeToolManager.SetVisibleEditorLines(NewValue: integer);
|
|
begin
|
|
if NewValue=FVisibleEditorLines then exit;
|
|
FVisibleEditorLines:=NewValue;
|
|
if FCurCodeTool<>nil then
|
|
FCurCodeTool.VisibleEditorLines:=NewValue;
|
|
end;
|
|
|
|
procedure TCodeToolManager.SetJumpCentered(NewValue: boolean);
|
|
begin
|
|
if NewValue=FJumpCentered then exit;
|
|
FJumpCentered:=NewValue;
|
|
if FCurCodeTool<>nil then
|
|
FCurCodeTool.JumpCentered:=NewValue;
|
|
end;
|
|
|
|
procedure TCodeToolManager.SetCursorBeyondEOL(NewValue: boolean);
|
|
begin
|
|
if NewValue=FCursorBeyondEOL then exit;
|
|
FCursorBeyondEOL:=NewValue;
|
|
if FCurCodeTool<>nil then
|
|
FCurCodeTool.CursorBeyondEOL:=NewValue;
|
|
end;
|
|
|
|
procedure TCodeToolManager.BeforeApplyingChanges(var Abort: boolean);
|
|
begin
|
|
if Assigned(FOnBeforeApplyChanges) then
|
|
FOnBeforeApplyChanges(Self,Abort);
|
|
end;
|
|
|
|
procedure TCodeToolManager.AfterApplyingChanges;
|
|
begin
|
|
if Assigned(FOnAfterApplyChanges) then
|
|
FOnAfterApplyChanges(Self);
|
|
end;
|
|
|
|
function TCodeToolManager.FindCodeToolForSource(Code: TCodeBuffer
|
|
): TCustomCodeTool;
|
|
var ANode: TAVLTreeNode;
|
|
CurSrc, SearchedSrc: integer;
|
|
begin
|
|
ANode:=FSourceTools.Root;
|
|
SearchedSrc:=integer(Code);
|
|
while (ANode<>nil) do begin
|
|
CurSrc:=integer(TCustomCodeTool(ANode.Data).Scanner.MainCode);
|
|
if CurSrc>SearchedSrc then
|
|
ANode:=ANode.Left
|
|
else if CurSrc<SearchedSrc then
|
|
ANode:=ANode.Right
|
|
else begin
|
|
Result:=TCustomCodeTool(ANode.Data);
|
|
exit;
|
|
end;
|
|
end;
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TCodeToolManager.GetCodeToolForSource(Code: TCodeBuffer;
|
|
ExceptionOnError: boolean): TCustomCodeTool;
|
|
// return a codetool for the source
|
|
var MainCode: TCodeBuffer;
|
|
begin
|
|
Result:=nil;
|
|
if Code=nil then begin
|
|
if ExceptionOnError then
|
|
raise Exception.Create('TCodeToolManager.GetCodeToolForSource '
|
|
+'internal error: Code=nil');
|
|
exit;
|
|
end;
|
|
Result:=FindCodeToolForSource(Code);
|
|
if Result=nil then begin
|
|
MainCode:=GetMainCode(Code); // create a scanner
|
|
if (MainCode<>Code) then begin
|
|
if ExceptionOnError then
|
|
raise Exception.Create('the source file "'+Code.Filename+'"'
|
|
+' is an include file of "'+Code.Filename+'"');
|
|
exit;
|
|
end;
|
|
Result:=TCodeCompletionCodeTool.Create;
|
|
Result.Scanner:=Code.Scanner;
|
|
FSourceTools.Add(Result);
|
|
end;
|
|
Result.CheckFilesOnDisk:=FCheckFilesOnDisk;
|
|
Result.IndentSize:=FIndentSize;
|
|
Result.VisibleEditorLines:=FVisibleEditorLines;
|
|
Result.JumpCentered:=FJumpCentered;
|
|
Result.CursorBeyondEOL:=FCursorBeyondEOL;
|
|
TFindDeclarationTool(Result).OnGetCodeToolForBuffer:=@OnGetCodeToolForBuffer;
|
|
end;
|
|
|
|
function TCodeToolManager.OnGetCodeToolForBuffer(Sender: TObject;
|
|
Code: TCodeBuffer): TFindDeclarationTool;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TCodeToolManager.OnGetCodeToolForBuffer]'
|
|
,' Sender=',TCustomCodeTool(Sender).Scanner.MainSource.Filename
|
|
,' Code=',Code.Filename);
|
|
{$ENDIF}
|
|
Result:=TFindDeclarationTool(GetCodeToolForSource(Code,true));
|
|
end;
|
|
|
|
function TCodeToolManager.ConsistencyCheck: integer;
|
|
// 0 = ok
|
|
begin
|
|
try
|
|
Result:=0;
|
|
if FCurCodeTool<>nil then begin
|
|
Result:=FCurCodeTool.ConsistencyCheck;
|
|
if Result<>0 then begin
|
|
dec(Result,1000); exit;
|
|
end;
|
|
end;
|
|
Result:=DefinePool.ConsistencyCheck;
|
|
if Result<>0 then begin
|
|
dec(Result,2000); exit;
|
|
end;
|
|
Result:=DefineTree.ConsistencyCheck;
|
|
if Result<>0 then begin
|
|
dec(Result,3000); exit;
|
|
end;
|
|
Result:=SourceCache.ConsistencyCheck;
|
|
if Result<>0 then begin
|
|
dec(Result,4000); exit;
|
|
end;
|
|
Result:=GlobalValues.ConsistencyCheck;
|
|
if Result<>0 then begin
|
|
dec(Result,5000); exit;
|
|
end;
|
|
Result:=SourceChangeCache.ConsistencyCheck;
|
|
if Result<>0 then begin
|
|
dec(Result,6000); exit;
|
|
end;
|
|
Result:=FSourceTools.ConsistencyCheck;
|
|
if Result<>0 then begin
|
|
dec(Result,7000); exit;
|
|
end;
|
|
finally
|
|
if (Result<>0) and (FCatchExceptions=false) then
|
|
raise Exception.Create(
|
|
'TCodeToolManager.ConsistencyCheck='+IntToStr(Result));
|
|
end;
|
|
Result:=0;
|
|
end;
|
|
|
|
procedure TCodeToolManager.WriteDebugReport(WriteTool,
|
|
WriteDefPool, WriteDefTree, WriteCache, WriteGlobalValues: boolean);
|
|
begin
|
|
writeln('[TCodeToolManager.WriteDebugReport] Consistency=',ConsistencyCheck);
|
|
if FCurCodeTool<>nil then begin
|
|
if WriteTool then
|
|
FCurCodeTool.WriteDebugTreeReport
|
|
else
|
|
writeln(' FCurCodeTool.ConsistencyCheck=',FCurCodeTool.ConsistencyCheck);
|
|
end;
|
|
if WriteDefPool then
|
|
DefinePool.WriteDebugReport
|
|
else
|
|
writeln(' DefinePool.ConsistencyCheck=',DefinePool.ConsistencyCheck);
|
|
if WriteDefTree then
|
|
DefineTree.WriteDebugReport
|
|
else
|
|
writeln(' DefineTree.ConsistencyCheck=',DefineTree.ConsistencyCheck);
|
|
if WriteCache then
|
|
SourceCache.WriteDebugReport
|
|
else
|
|
writeln(' SourceCache.ConsistencyCheck=',SourceCache.ConsistencyCheck);
|
|
if WriteGlobalValues then
|
|
GlobalValues.WriteDebugReport
|
|
else
|
|
writeln(' GlobalValues.ConsistencyCheck=',GlobalValues.ConsistencyCheck);
|
|
end;
|
|
|
|
//-----------------------------------------------------------------------------
|
|
|
|
initialization
|
|
CodeToolBoss:=TCodeToolManager.Create;
|
|
|
|
|
|
finalization
|
|
{$IFDEF CTDEBUG}
|
|
writeln('codetoolmanager.pas - finalization');
|
|
{$ENDIF}
|
|
CodeToolBoss.Free;
|
|
CodeToolBoss:=nil;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('codetoolmanager.pas - finalization finished');
|
|
{$ENDIF}
|
|
|
|
end.
|
|
|