paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 08:29:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: added complete code

Browse Source 
git-svn-id: trunk@349 -
This commit is contained in:
lazarus 2001-10-15 13:11:28 +00:00
parent 55ebf6b711
commit a4f8e5ce80
12 changed files with 1053 additions and 508 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
components/codetools/basiccodetools.pas
View File

@ -1131,6 +1131,7 @@ function FindLineEndOrCodeAfterPosition(const Source: string;
Position: integer; NestedComments: boolean): integer;
{ search forward for a line end or code
ignore line ends in comments
Result is Position of Start of Line End
}
var SrcLen: integer;
@ -1203,7 +1204,33 @@ end;
function FindLineEndOrCodeInFrontOfPosition(const Source: string;
Position: integer; NestedComments: boolean): integer;
{ search backward for a line end or code
ignore line ends in comments
ignore line ends in comments or at the end of comment lines
(comment lines are lines without code and at least one comment)
Result is Position of Start of Line End
examples: Position points at char 'a'
1: |
2: a:=1;
1: b:=1; |
2: // comment
3: // comment
4: a:=1;
1: |
2: /* */
3: a:=1;
1: end;| /*
2: */ a:=1;
1: b:=1; // comment |
2: a:=1;
1: b:=1; /*
2: comment */ |
3: a:=1;
}
procedure ReadComment(var P: integer);
begin
@ -1238,34 +1265,48 @@ function FindLineEndOrCodeInFrontOfPosition(const Source: string;
end;
var TestPos: integer;
OnlySpace: boolean;
begin
Result:=Position;
if Position<=1 then begin
Result:=1;
exit;
end;
Result:=Position-1;
while (Result>0) do begin
case Source[Result] of
'}',')':
ReadComment(Result);
#10,#13:
begin
// test if it is a '//' comment
// line end in code found
dec(Result);
if (Result>1) and (Source[Result-1] in [#10,#13])
and (Source[Result]<>Source[Result-1]) then dec(Result);
// test if it is a comment line (a line without code and at least one
// comment)
TestPos:=Result-1;
OnlySpace:=true;
while (TestPos>1) do begin
if (Source[TestPos]='/') and (Source[TestPos-1]='/') then begin
// this is a comment line end -> search further
dec(TestPos);
break;
end else if Source[TestPos] in [#10,#13] then begin
// no comment, the line end ist really there :)
exit;
end else
end else if OnlySpace and (Source[TestPos] in ['}',')']) then begin
// this is a comment line end -> search further
break;
end else begin
if (Source[Result]>' ') then OnlySpace:=false;
dec(TestPos);
end;
end;
Result:=TestPos;
end;
else
begin
if (Source[Result]<=' ') or (Source[Result]=';') then
if (Source[Result]<=' ') or (Source[Result] in [';',',']) then
dec(Result)
else
exit;

40
components/codetools/codetoolmanager.pas
View File

@ -48,6 +48,7 @@ type
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
@ -59,6 +60,7 @@ type
FJumpCentered: boolean;
FCursorBeyondEOL: boolean;
FOnBeforeApplyChanges: TOnBeforeApplyChanges;
FOnAfterApplyChanges: TOnAfterApplyChanges;
FLastException: Exception;
FCatchExceptions: boolean;
FWriteExceptions: boolean;
@ -74,6 +76,7 @@ type
procedure SetJumpCentered(NewValue: boolean);
procedure SetCursorBeyondEOL(NewValue: boolean);
procedure BeforeApplyingChanges(var Abort: boolean);
procedure AfterApplyingChanges;
function HandleException(AnException: Exception): boolean;
public
DefinePool: TDefinePool; // definitions for all directories (rules)
@ -81,6 +84,10 @@ type
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
@ -112,6 +119,8 @@ type
// events
property OnBeforeApplyChanges: TOnBeforeApplyChanges
read FOnBeforeApplyChanges write FOnBeforeApplyChanges;
property OnAfterApplyChanges: TOnAfterApplyChanges
read FOnAfterApplyChanges write FOnAfterApplyChanges;
// method jumping
function JumpToMethod(Code: TCodeBuffer; X,Y: integer;
@ -217,6 +226,7 @@ begin
SourceCache:=TCodeCache.Create;
SourceChangeCache:=TSourceChangeCache.Create;
SourceChangeCache.OnBeforeApplyChanges:=@BeforeApplyingChanges;
SourceChangeCache.OnAfterApplyChanges:=@AfterApplyingChanges;
GlobalValues:=TExpressionEvaluator.Create;
FSourceExtensions:='.pp;.pas;.lpr;.dpr;.dpk';
FLastException:=nil;
@ -243,11 +253,16 @@ writeln('[TCodeToolManager.Destroy] C');
{$ENDIF}
DefineTree.Free;
DefinePool.Free;
SourceChangeCache.Free;
SourceCache.Free;
FLastException.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}
@ -258,6 +273,16 @@ 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);
@ -1019,6 +1044,12 @@ begin
FOnBeforeApplyChanges(Self,Abort);
end;
procedure TCodeToolManager.AfterApplyingChanges;
begin
if Assigned(FOnAfterApplyChanges) then
FOnAfterApplyChanges(Self);
end;
function TCodeToolManager.ConsistencyCheck: integer;
// 0 = ok
begin
@ -1098,6 +1129,9 @@ writeln('codetoolmanager.pas - finalization');
{$ENDIF}
CodeToolBoss.Free;
CodeToolBoss:=nil;
{$IFDEF CTDEBUG}
writeln('codetoolmanager.pas - finalization finished');
{$ENDIF}
end.

128
components/codetools/codetools.pas
View File

@ -4770,7 +4770,7 @@ begin
OldPosition:=FindLazarusResourceInBuffer(ResourceCode,ResourceName);
if OldPosition.StartPos>0 then begin
// replace old resource
FromPos:=FindFirstLineEndInFrontOfInCode(Src,OldPosition.StartPos,
FromPos:=FindLineEndOrCodeInFrontOfPosition(Src,OldPosition.StartPos,
Scanner.NestedComments);
ToPos:=FindFirstLineEndAfterInCode(Src,OldPosition.EndPos,
Scanner.NestedComments);
@ -4810,7 +4810,7 @@ begin
SourceChangeCache.MainScanner:=Scanner;
OldPosition:=FindLazarusResourceInBuffer(ResourceCode,ResourceName);
if OldPosition.StartPos>0 then begin
OldPosition.StartPos:=FindFirstLineEndInFrontOfInCode(Src,
OldPosition.StartPos:=FindLineEndOrCodeInFrontOfPosition(Src,
OldPosition.StartPos,Scanner.NestedComments);
OldPosition.EndPos:=FindFirstLineEndAfterInCode(Src,OldPosition.EndPos,
Scanner.NestedComments);
@ -4954,13 +4954,13 @@ begin
if FromPos<1 then exit;
SourceChangeCache.MainScanner:=Scanner;
Indent:=GetLineIndent(Src,FromPos);
FromPos:=FindFirstLineEndInFrontOfInCode(Src,FromPos,
FromPos:=FindLineEndOrCodeInFrontOfPosition(Src,FromPos,
Scanner.NestedComments);
SourceChangeCache.Replace(gtNewLine,gtNewLine,FromPos,FromPos,
SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
'Application.CreateForm('+AClassName+','+AVarName+');',Indent));
end else begin
FromPos:=FindFirstLineEndInFrontOfInCode(Src,OldPosition.StartPos,
FromPos:=FindLineEndOrCodeInFrontOfPosition(Src,OldPosition.StartPos,
Scanner.NestedComments);
ToPos:=FindFirstLineEndAfterInCode(Src,OldPosition.EndPos,
Scanner.NestedComments);
@ -4980,7 +4980,7 @@ begin
Result:=false;
if FindCreateFormStatement(-1,'*',UpperVarName,Position)=-1 then
exit;
FromPos:=FindFirstLineEndInFrontOfInCode(Src,Position.StartPos,
FromPos:=FindLineEndOrCodeInFrontOfPosition(Src,Position.StartPos,
Scanner.NestedComments);
ToPos:=FindFirstLineEndAfterInCode(Src,Position.EndPos,
Scanner.NestedComments);
@ -5043,7 +5043,7 @@ begin
if FindCreateFormStatement(Position,'*','*',StatementPos)=-1 then
break;
Position:=StatementPos.EndPos;
StatementPos.StartPos:=FindFirstLineEndInFrontOfInCode(Src,
StatementPos.StartPos:=FindLineEndOrCodeInFrontOfPosition(Src,
StatementPos.StartPos,Scanner.NestedComments);
InsertPos:=StatementPos.StartPos;
StatementPos.EndPos:=FindFirstLineEndAfterInCode(Src,
@ -5138,7 +5138,7 @@ begin
Indent:=GetLineIndent(Src,SectionNode.StartPos)
+SourceChangeCache.BeautifyCodeOptions.Indent;
end;
InsertPos:=FindFirstLineEndInFrontOfInCode(Src,SectionNode.EndPos,
InsertPos:=FindLineEndOrCodeInFrontOfPosition(Src,SectionNode.EndPos,
Scanner.NestedComments);
SourceChangeCache.Replace(gtNewLine,gtNewLine,InsertPos,InsertPos,
SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
@ -5172,9 +5172,9 @@ begin
if VarNode.FirstChild<>nil then begin
// variable definition has the form 'VarName: VarType;'
// -> delete whole line
FromPos:=FindFirstLineEndInFrontOfInCode(Src,VarNode.StartPos,
FromPos:=FindLineEndOrCodeInFrontOfPosition(Src,VarNode.StartPos,
Scanner.NestedComments);
ToPos:=FindLineEndOrCodeAfterPosition(Src,VarNode.EndPos,
ToPos:=FindFirstLineEndAfterInCode(Src,VarNode.EndPos,
Scanner.NestedComments);
end else begin
// variable definition has the form 'VarName, NextVarName: VarType;'
@ -6051,7 +6051,7 @@ writeln('[TEventsCodeTool.InsertNewMethodToClass] B');
{$ENDIF}
InsertNode:=ClassSectionNode.LastChild;
Indent:=GetLineIndent(Src,InsertNode.StartPos);
InsertPos:=FindLineEndOrCodeAfterPosition(Src,InsertNode.EndPos,
InsertPos:=FindFirstLineEndAfterInCode(Src,InsertNode.EndPos,
Scanner.NestedComments);
end else begin
// insert alphabetically
@ -6073,12 +6073,12 @@ writeln('[TEventsCodeTool.InsertNewMethodToClass] C');
// insert after InsertNode.PriorBrother
InsertNode:=InsertNode.PriorBrother;
Indent:=GetLineIndent(Src,InsertNode.StartPos);
InsertPos:=FindLineEndOrCodeAfterPosition(Src,InsertNode.EndPos,
InsertPos:=FindFirstLineEndAfterInCode(Src,InsertNode.EndPos,
Scanner.NestedComments);
end else begin
// insert as first
Indent:=GetLineIndent(Src,InsertNode.StartPos);
InsertPos:=FindLineEndOrCodeAfterPosition(Src,
InsertPos:=FindFirstLineEndAfterInCode(Src,
ClassSectionNode.EndPos,Scanner.NestedComments);
end;
end else begin
@ -6297,6 +6297,9 @@ procedure TCodeCompletionCodeTool.AddInsert(PosNode: TCodeTreeNode;
const CleanDef, Def, IdentifierName: string);
var NewInsert, InsertPos, Last: TCodeTreeNodeExtension;
begin
{$IFDEF CTDEBUG}
writeln('[TCodeCompletionCodeTool.AddInsert] ',CleanDef,',',Def,',',Identifiername);
{$ENDIF}
NewInsert:=NodeExtMemManager.NewNode;
with NewInsert do begin
Node:=PosNode;
@ -6407,6 +6410,9 @@ begin
MoveCursorToNodeStart(PropNode);
ReadNextAtom; // read 'property'
ReadNextAtom; // read name
{$IFDEF CTDEBUG}
writeln('[TCodeCompletionCodeTool.CompleteProperty] Checking Property ',GetAtom);
{$ENDIF}
Parts[ppName]:=CurPos;
ReadNextAtom;
if AtomIsChar('[') then begin
@ -6414,20 +6420,32 @@ begin
Parts[ppParamList].StartPos:=CurPos.StartPos;
InitExtraction;
if not ReadParamList(false,true,[phpInUpperCase,phpWithoutBrackets])
then exit;
then begin
{$IFDEF CTDEBUG}
writeln('[TCodeCompletionCodeTool.CompleteProperty] error parsing param list');
{$ENDIF}
exit;
end;
CleanParamList:=GetExtraction;
Parts[ppParamList].EndPos:=CurPos.EndPos;
ReadNextAtom;
end else
CleanParamList:='';
if not AtomIsChar(':') then begin
{$IFDEF CTDEBUG}
writeln('[TCodeCompletionCodeTool.CompleteProperty] no type : found -> ignore property');
{$ENDIF}
// no type -> ignore this property
Result:=true;
exit;
end;
ReadNextAtom; // read type
if (CurPos.StartPos>PropNode.EndPos)
or UpAtomIs('END') or AtomIsChar(';') then exit;
or UpAtomIs('END') or AtomIsChar(';') then begin
{$IFDEF CTDEBUG}
writeln('[TCodeCompletionCodeTool.CompleteProperty] error: no type name found');
{$ENDIF}
exit;
end;
Parts[ppType]:=CurPos;
// read specifiers
ReadNextAtom;
@ -6472,6 +6490,9 @@ begin
// check read specifier
if (Parts[ppReadWord].StartPos>0) or (Parts[ppWriteWord].StartPos<1) then
begin
{$IFDEF CTDEBUG}
writeln('[TCodeCompletionCodeTool.CompleteProperty] read specifier needed');
{$ENDIF}
AccessParamPrefix:=
ASourceChangeCache.BeautifyCodeOptions.PropertyReadIdentPrefix;
if Parts[ppRead].StartPos>0 then
@ -6483,10 +6504,10 @@ begin
or (AnsiCompareText(AccessParamPrefix,
LeftStr(AccessParam,length(AccessParamPrefix)))=0) then
begin
// the read identifier is a function
if Parts[ppRead].StartPos<1 then
AccessParam:=AccessParamPrefix+copy(Src,Parts[ppName].StartPos,
Parts[ppName].EndPos-Parts[ppName].StartPos);
// the read identifier is a function
if (Parts[ppParamList].StartPos>0) then begin
if (Parts[ppIndexWord].StartPos<1) then begin
// param list, no index
@ -6507,16 +6528,24 @@ begin
end;
// check if function exists
if not ProcExists(CleanAccessFunc) then begin
{$IFDEF CTDEBUG}
writeln('[TCodeCompletionCodeTool.CompleteProperty] CleanAccessFunc ',CleanAccessFunc,' does not exist');
{$ENDIF}
// add insert demand for function
// build function code
if (Parts[ppParamList].StartPos>0) then begin
MoveCursorToCleanPos(Parts[ppParamList].StartPos);
ReadNextAtom;
InitExtraction;
if not ReadParamList(false,true,[phpWithParameterNames,
phpWithoutBrackets,phpWithVarModifiers,
phpWithComments])
then
then begin
{$IFDEF CTDEBUG}
writeln('[TCodeCompletionCodeTool.CompleteProperty] Error reading param list');
{$ENDIF}
exit;
end;
ParamList:=GetExtraction;
if (Parts[ppIndexWord].StartPos<1) then begin
// param list, no index
@ -6576,6 +6605,9 @@ begin
// check write specifier
if (Parts[ppWriteWord].StartPos>0) or (Parts[ppReadWord].StartPos<1) then
begin
{$IFDEF CTDEBUG}
writeln('[TCodeCompletionCodeTool.CompleteProperty] write specifier needed');
{$ENDIF}
AccessParamPrefix:=
ASourceChangeCache.BeautifyCodeOptions.PropertyWriteIdentPrefix;
if Parts[ppWrite].StartPos>0 then
@ -6616,6 +6648,7 @@ begin
// build function code
if (Parts[ppParamList].StartPos>0) then begin
MoveCursorToCleanPos(Parts[ppParamList].StartPos);
ReadNextAtom;
InitExtraction;
if not ReadParamList(false,true,[phpWithParameterNames,
phpWithoutBrackets,phpWithVarModifiers,
@ -6683,6 +6716,9 @@ begin
end;
// check stored specifier
if (Parts[ppStoredWord].StartPos>0) then begin
{$IFDEF CTDEBUG}
writeln('[TCodeCompletionCodeTool.CompleteProperty] stored specifier needed');
{$ENDIF}
if Parts[ppStored].StartPos>0 then
AccessParam:=copy(Src,Parts[ppStored].StartPos,
Parts[ppStored].EndPos-Parts[ppStored].StartPos)
@ -7046,7 +7082,6 @@ var CleanCursorPos, Dummy, Indent, insertPos: integer;
CursorNode, ProcNode, ImplementationNode, SectionNode,
ANode: TCodeTreeNode;
ProcCode: string;
InInterface: boolean;
ANodeExt: TCodeTreeNodeExtension;
begin
Result:=false;
@ -7066,7 +7101,6 @@ begin
{$IFDEF CTDEBUG}
writeln('TCodeCompletionCodeTool.CompleteCode A ',NodeDescriptionAsString(CursorNode.Desc));
{$ENDIF}
InInterface:=NodeHasParentOfType(CursorNode,ctnInterface);
ImplementationNode:=FindImplementationNode;
if ImplementationNode=nil then ImplementationNode:=Tree.Root;
FirstInsert:=nil;
@ -7077,7 +7111,7 @@ writeln('TCodeCompletionCodeTool.CompleteCode A ',NodeDescriptionAsString(Cursor
ClassNode:=ClassNode.Parent;
if ClassNode<>nil then begin
{$IFDEF CTDEBUG}
writeln('TCodeCompletionCodeTool.CompleteCode B ',NodeDescriptionAsString(ClassNode.Desc));
writeln('TCodeCompletionCodeTool.CompleteCode In-a-class ',NodeDescriptionAsString(ClassNode.Desc));
{$ENDIF}
// cursor is in class/object definition
if CursorNode.SubDesc=ctnsForwardDeclaration then exit;
@ -7184,34 +7218,40 @@ writeln('TCodeCompletionCodeTool.CompleteCode Apply ... ');
if (ProcNode.Desc=ctnProcedure)
and (ProcNode.SubDesc=ctnsForwardDeclaration) then begin
// Node is forward Proc
if InInterface then begin
// node is forward proc in interface
// check if proc already exists
ProcCode:=ExtractProcHead(ProcNode,[phpInUpperCase]);
if FindProcNode(FindNextNodeOnSameLvl(ProcNode),ProcCode,
[phpInUpperCase])<>nil
then exit;
// check if proc already exists
ProcCode:=ExtractProcHead(ProcNode,[phpInUpperCase]);
if FindProcNode(FindNextNodeOnSameLvl(ProcNode),ProcCode,
[phpInUpperCase])<>nil
then exit;
// -> create proc body at end of implementation
// -> create proc body at end of implementation
Indent:=GetLineIndent(Src,ImplementationNode.StartPos);
InsertPos:=ImplementationNode.EndPos;
// build nice proc
ProcCode:=ExtractProcHead(ProcNode,[phpWithStart,phpWithVarModifiers,
phpWithParameterNames,phpWithResultType,phpWithComments]);
if ProcCode='' then exit;
ProcCode:=SourceChangeCache.BeautifyCodeOptions.BeautifyProc(ProcCode,
Indent,true);
if not SourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,
InsertPos,InsertPos,ProcCode) then exit;
if not SourceChangeCache.Apply then exit;
// reparse code and find jump point into new proc
Result:=FindJumpPoint(CursorPos,NewPos,NewTopLine);
exit;
Indent:=GetLineIndent(Src,ImplementationNode.StartPos);
if ImplementationNode.Desc=ctnImplementation then
InsertPos:=FindLineEndOrCodeInFrontOfPosition(Src,
ImplementationNode.EndPos,Scanner.NestedComments)
else begin
// insert in front of main program begin..end.
StartNode:=ImplementationNode.LastChild;
if (StartNode=nil) or (StartNode.Desc<>ctnBeginBlock) then exit;
InsertPos:=FindLineEndOrCodeInFrontOfPosition(Src,StartNode.StartPos,
Scanner.NestedComments);
end;
// build nice proc
ProcCode:=ExtractProcHead(ProcNode,[phpWithStart,phpWithVarModifiers,
phpWithParameterNames,phpWithResultType,phpWithComments]);
if ProcCode='' then exit;
ProcCode:=SourceChangeCache.BeautifyCodeOptions.BeautifyProc(ProcCode,
Indent,true);
if not SourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,
InsertPos,InsertPos,ProcCode) then exit;
if not SourceChangeCache.Apply then exit;
// reparse code and find jump point into new proc
Result:=FindJumpPoint(CursorPos,NewPos,NewTopLine);
exit;
end;
end;
end;

4
components/codetools/linkscanner.pas
View File

@ -1565,7 +1565,7 @@ procedure TLinkScanner.FindCodeInRange(CleanStartPos, CleanEndPos: integer;
var ACode: Pointer;
LinkIndex: integer;
begin
if (CleanStartPos<1) or (CleanStartPos>=CleanEndPos)
if (CleanStartPos<1) or (CleanStartPos>CleanEndPos)
or (CleanEndPos>CleanedLen+1) or (UniqueSortedCodeList=nil) then exit;
LinkIndex:=LinkIndexAtCleanPos(CleanStartPos);
if LinkIndex<0 then exit;
@ -1577,7 +1577,7 @@ begin
exit;
if ACode<>Links[LinkIndex].Code then begin
ACode:=Links[LinkIndex].Code;
AddCodeToList(ACode);
AddCodeToList(ACode);
end;
until false;
end;

10
components/codetools/memcheck.pas
View File

@ -64,6 +64,8 @@ const
{ put crc in sig
this allows to test for writing into that part }
usecrc : boolean = true;
MaxDumpCnt : integer = 10;
var
getmem_cnt,
@ -806,7 +808,7 @@ end;
procedure dumpheap;
var
pp : pheap_mem_info;
i : longint;
i, WrittenCnt : longint;
ExpectedMemAvail : longint;
begin
pp:=heap_mem_root;
@ -825,6 +827,7 @@ begin
If ExpectedMemAvail<>MemAvail then
Writeln(ptext^,'Should be : ',ExpectedMemAvail);
i:=getmem_cnt-freemem_cnt;
WrittenCnt:=0;
while pp<>nil do
begin
if i<0 then
@ -855,9 +858,10 @@ begin
dump_change_after(pp,ptext^);
dump_change_after(pp,error_file);
error_in_heap:=true;
end
end;
{$endif EXTRA}
;
inc(WrittenCnt);
if WrittenCnt>=MaxDumpCnt then break;
pp:=pp^.previous;
end;
end;

246
components/codetools/sourcechanger.pas
View File

@ -118,6 +118,7 @@ type
//----------------------------------------------------------------------------
TOnBeforeApplyChanges = procedure(var Abort: boolean) of object;
TOnAfterApplyChanges = procedure of object;
TSourceChangeCache = class
private
@ -126,6 +127,8 @@ type
FBuffersToModify: TList; // sorted list of TCodeBuffer
FBuffersToModifyNeedsUpdate: boolean;
FOnBeforeApplyChanges: TOnBeforeApplyChanges;
FOnAfterApplyChanges: TOnAfterApplyChanges;
FUpdateLock: integer;
Src: string;
procedure DeleteOldText(CleanFromPos,CleanToPos: integer);
procedure InsertNewText(ACode: TCodeBuffer; DirectPos: integer;
@ -139,6 +142,8 @@ type
procedure UpdateBuffersToModify;
public
BeautifyCodeOptions: TBeautifyCodeOptions;
procedure BeginUpdate;
procedure EndUpdate;
property MainScanner: TLinkScanner read FMainScanner write SetMainScanner;
function Replace(FrontGap, AfterGap: TGapTyp; FromPos, ToPos: integer;
const Text: string): boolean;
@ -151,8 +156,11 @@ type
property BuffersToModify[Index: integer]: TCodeBuffer
read GetBuffersToModify;
function BuffersToModifyCount: integer;
function BufferIsModified(ACode: TCodeBuffer): boolean;
property OnBeforeApplyChanges: TOnBeforeApplyChanges
read FOnBeforeApplyChanges write FOnBeforeApplyChanges;
property OnAfterApplyChanges: TOnAfterApplyChanges
read FOnAfterApplyChanges write FOnAfterApplyChanges;
procedure Clear;
function ConsistencyCheck: integer;
procedure WriteDebugReport;
@ -264,10 +272,12 @@ var ANode: TAVLTreeNode;
NewEntry: TSourceChangeCacheEntry;
p: pointer;
begin
{$IFDEF CTDEBUG}
writeln('TSourceChangeCache.ReplaceEx FrontGap=',ord(FrontGap),
' AfterGap=',ord(AfterGap),' FromPos=',FromPos,' ToPos=',ToPos,
' Text="',Text,'"');
if FromCode<>nil then writeln('FromCode=',FromCode.Filename,' FromDirectPos=',FromDirectPos);
{$ENDIF}
Result:=false;
if (MainScanner=nil) or (FromPos>ToPos) or (FromPos<1)
or (ToPos>MainScanner.CleanedLen+1) then
@ -294,7 +304,9 @@ if FromCode<>nil then writeln('FromCode=',FromCode.Filename,' FromDirectPos=',Fr
FEntries.MoveDataRightMost(ANode);
FBuffersToModifyNeedsUpdate:=true;
Result:=true;
{$IFDEF CTDEBUG}
writeln('TSourceChangeCache.ReplaceEx SUCCESS');
{$ENDIF}
end;
function TSourceChangeCache.Replace(FrontGap, AfterGap: TGapTyp;
@ -305,8 +317,10 @@ end;
procedure TSourceChangeCache.Clear;
begin
FUpdateLock:=0;
FEntries.FreeAndClear;
FBuffersToModify.Clear;
FBuffersToModifyNeedsUpdate:=true;
end;
function TSourceChangeCache.ConsistencyCheck: integer;
@ -338,9 +352,15 @@ var CurNode, PrecNode: TAVLTreeNode;
BetweenGap: TGapTyp;
Abort: boolean;
begin
{$IFDEF CTDEBUG}
writeln('TSourceChangeCache.Apply EntryCount=',FEntries.Count);
{$ENDIF}
Result:=false;
if MainScanner=nil then exit;
if FUpdateLock>0 then begin
Result:=true;
exit;
end;
if Assigned(FOnBeforeApplyChanges) then begin
Abort:=false;
FOnBeforeApplyChanges(Abort);
@ -349,97 +369,105 @@ writeln('TSourceChangeCache.Apply EntryCount=',FEntries.Count);
exit;
end;
end;
Src:=MainScanner.CleanedSrc;
// apply the changes beginning with the last
CurNode:=FEntries.FindHighest;
while CurNode<>nil do begin
FirstEntry:=TSourceChangeCacheEntry(CurNode.Data);
try
Src:=MainScanner.CleanedSrc;
// apply the changes beginning with the last
CurNode:=FEntries.FindHighest;
while CurNode<>nil do begin
FirstEntry:=TSourceChangeCacheEntry(CurNode.Data);
{$IFDEF CTDEBUG}
writeln('TSourceChangeCache.Apply Pos=',FirstEntry.FromPos,'-',FirstEntry.ToPos,
' Text="',FirstEntry.Text,'"');
InsertText:=FirstEntry.Text;
// add after gap
case FirstEntry.AfterGap of
gtSpace:
begin
if ((FirstEntry.ToPos>MainScanner.CleanedLen)
or (not IsSpaceChar[MainScanner.Src[FirstEntry.ToPos]])) then
InsertText:=InsertText+' ';
end;
gtNewLine:
begin
NeededLineEnds:=CountNeededLineEndsToAddForward(FirstEntry.ToPos,1);
if NeededLineEnds>0 then
InsertText:=InsertText+BeautifyCodeOptions.LineEnd;
end;
gtEmptyLine:
begin
NeededLineEnds:=CountNeededLineEndsToAddForward(FirstEntry.ToPos,2);
for i:=1 to NeededLineEnds do
InsertText:=InsertText+BeautifyCodeOptions.LineEnd;
end;
end;
if FirstEntry.AfterGap in [gtNewLine,gtEmptyLine] then begin
NeededIndent:=GetLineIndent(MainScanner.Src,FirstEntry.ToPos);
j:=FirstEntry.ToPos;
while (j<=MainScanner.SrcLen) and (IsSpaceChar[MainScanner.Src[j]]) do
inc(j);
dec(NeededIndent,j-FirstEntry.ToPos);
if NeededIndent>0 then
InsertText:=InsertText+GetIndentStr(NeededIndent);
end;
// add text from nodes inserted at the same position
PrecNode:=FEntries.FindPrecessor(CurNode);
CurEntry:=FirstEntry;
while (PrecNode<>nil) do begin
PrecEntry:=TSourceChangeCacheEntry(PrecNode.Data);
if PrecEntry.FromPos=CurEntry.FromPos then begin
BetweenGap:=PrecEntry.AfterGap;
if ord(BetweenGap)<ord(CurEntry.FrontGap) then
BetweenGap:=CurEntry.FrontGap;
case BetweenGap of
gtSpace:
InsertText:=' '+InsertText;
gtNewLine:
InsertText:=BeautifyCodeOptions.LineEnd+InsertText;
gtEmptyLine:
InsertText:=BeautifyCodeOptions.LineEnd+BeautifyCodeOptions.LineEnd
+InsertText;
end;
InsertText:=PrecEntry.Text+InsertText;
end else
break;
CurNode:=PrecNode;
CurEntry:=PrecEntry;
{$ENDIF}
InsertText:=FirstEntry.Text;
// add after gap
case FirstEntry.AfterGap of
gtSpace:
begin
if ((FirstEntry.ToPos>MainScanner.CleanedLen)
or (not IsSpaceChar[MainScanner.Src[FirstEntry.ToPos]])) then
InsertText:=InsertText+' ';
end;
gtNewLine:
begin
NeededLineEnds:=CountNeededLineEndsToAddForward(FirstEntry.ToPos,1);
if NeededLineEnds>0 then
InsertText:=InsertText+BeautifyCodeOptions.LineEnd;
end;
gtEmptyLine:
begin
NeededLineEnds:=CountNeededLineEndsToAddForward(FirstEntry.ToPos,2);
for i:=1 to NeededLineEnds do
InsertText:=InsertText+BeautifyCodeOptions.LineEnd;
end;
end;
if FirstEntry.AfterGap in [gtNewLine,gtEmptyLine] then begin
NeededIndent:=GetLineIndent(MainScanner.Src,FirstEntry.ToPos);
j:=FirstEntry.ToPos;
while (j<=MainScanner.SrcLen) and (IsSpaceChar[MainScanner.Src[j]]) do
inc(j);
dec(NeededIndent,j-FirstEntry.ToPos);
if NeededIndent>0 then
InsertText:=InsertText+GetIndentStr(NeededIndent);
end;
// add text from nodes inserted at the same position
PrecNode:=FEntries.FindPrecessor(CurNode);
CurEntry:=FirstEntry;
while (PrecNode<>nil) do begin
PrecEntry:=TSourceChangeCacheEntry(PrecNode.Data);
if PrecEntry.FromPos=CurEntry.FromPos then begin
BetweenGap:=PrecEntry.AfterGap;
if ord(BetweenGap)<ord(CurEntry.FrontGap) then
BetweenGap:=CurEntry.FrontGap;
case BetweenGap of
gtSpace:
InsertText:=' '+InsertText;
gtNewLine:
InsertText:=BeautifyCodeOptions.LineEnd+InsertText;
gtEmptyLine:
InsertText:=BeautifyCodeOptions.LineEnd
+BeautifyCodeOptions.LineEnd+InsertText;
end;
InsertText:=PrecEntry.Text+InsertText;
end else
break;
CurNode:=PrecNode;
CurEntry:=PrecEntry;
PrecNode:=FEntries.FindPrecessor(CurNode);
end;
// add front gap
case CurEntry.FrontGap of
gtSpace:
begin
if (CurEntry.FromPos=1)
or (not IsSpaceChar[MainScanner.Src[CurEntry.FromPos-1]]) then
InsertText:=' '+InsertText;
end;
gtNewLine:
begin
NeededLineEnds:=CountNeededLineEndsToAddBackward(
CurEntry.FromPos-1,1);
if NeededLineEnds>0 then
InsertText:=BeautifyCodeOptions.LineEnd+InsertText;
end;
gtEmptyLine:
begin
NeededLineEnds:=CountNeededLineEndsToAddBackward(
CurEntry.FromPos-1,2);
for i:=1 to NeededLineEnds do
InsertText:=BeautifyCodeOptions.LineEnd+InsertText;
end;
end;
// delete old text in code buffers
DeleteOldText(FirstEntry.FromPos,FirstEntry.ToPos);
// insert new text
InsertNewText(FirstEntry.FromCode,FirstEntry.FromDirectPos,InsertText);
CurNode:=PrecNode;
end;
// add front gap
case CurEntry.FrontGap of
gtSpace:
begin
if (CurEntry.FromPos=1)
or (not IsSpaceChar[MainScanner.Src[CurEntry.FromPos-1]]) then
InsertText:=' '+InsertText;
end;
gtNewLine:
begin
NeededLineEnds:=CountNeededLineEndsToAddBackward(CurEntry.FromPos-1,1);
if NeededLineEnds>0 then
InsertText:=BeautifyCodeOptions.LineEnd+InsertText;
end;
gtEmptyLine:
begin
NeededLineEnds:=CountNeededLineEndsToAddBackward(CurEntry.FromPos-1,2);
for i:=1 to NeededLineEnds do
InsertText:=BeautifyCodeOptions.LineEnd+InsertText;
end;
end;
// delete old text in code buffers
DeleteOldText(FirstEntry.FromPos,FirstEntry.ToPos);
// insert new text
InsertNewText(FirstEntry.FromCode,FirstEntry.FromDirectPos,InsertText);
CurNode:=PrecNode;
finally
if Assigned(FOnAfterApplyChanges) then FOnAfterApplyChanges();
FEntries.FreeAndClear;
end;
FEntries.FreeAndClear;
Result:=true;
end;
@ -489,18 +517,35 @@ end;
procedure TSourceChangeCache.DeleteOldText(CleanFromPos,CleanToPos: integer);
begin
{$IFDEF CTDEBUG}
writeln('[TSourceChangeCache.DeleteOldText] Pos=',CleanFromPos,'-',CleanToPos);
{$ENDIF}
MainScanner.DeleteRange(CleanFromPos,CleanToPos);
end;
procedure TSourceChangeCache.InsertNewText(ACode: TCodeBuffer;
DirectPos: integer; const InsertText: string);
begin
{$IFDEF CTDEBUG}
writeln('[TSourceChangeCache.InsertNewText] Code=',ACode.Filename,
' Pos=',DirectPos,' Text="',InsertText,'"');
{$ENDIF}
ACode.Insert(DirectPos,InsertText);
end;
procedure TSourceChangeCache.BeginUpdate;
begin
inc(FUpdateLock);
end;
procedure TSourceChangeCache.EndUpdate;
begin
if FUpdateLock<=0 then exit;
dec(FUpdateLock);
if FUpdateLock<=0 then
Apply;
end;
procedure TSourceChangeCache.SetMainScanner(NewScanner: TLinkScanner);
begin
if NewScanner=FMainScanner then exit;
@ -520,6 +565,12 @@ begin
Result:=FBuffersToModify.Count;
end;
function TSourceChangeCache.BufferIsModified(ACode: TCodeBuffer): boolean;
begin
UpdateBuffersToModify;
Result:=FBuffersToModify.IndexOf(ACode)>=0;
end;
procedure TSourceChangeCache.UpdateBuffersToModify;
// build a sorted and unique list of all TCodeBuffer(s) which will be modified
// by the 'Apply' operation
@ -527,6 +578,7 @@ var ANode: TAVLTreeNode;
AnEntry: TSourceChangeCacheEntry;
begin
if not FBuffersToModifyNeedsUpdate then exit;
//writeln('[TSourceChangeCache.UpdateBuffersToModify]');
FBuffersToModify.Clear;
ANode:=FEntries.FindLowest;
while ANode<>nil do begin
@ -559,18 +611,22 @@ begin
end;
procedure TBeautifyCodeOptions.AddAtom(var s:string; NewAtom: string);
var RestLineLen: integer;
var RestLineLen, LastLineEndInAtom: integer;
begin
if NewAtom='' then exit;
//writeln(' AddAtom="',NewAtom,'"');
//writeln('[TBeautifyCodeOptions.AddAtom] NewAtom=',NewAtom);
if IsIdentStartChar[NewAtom[1]] then begin
if WordIsKeyWord.DoIt(NewAtom) then
NewAtom:=BeautifyWord(NewAtom,KeyWordPolicy)
else
NewAtom:=BeautifyWord(NewAtom,IdentifierPolicy);
end;
if (CurLineLen+length(NewAtom)>LineLength) and (LastSplitPos>0) then begin
//writeln(' NEW LINE "',copy(s,LastSplitPos,5));
LastLineEndInAtom:=length(NewAtom);
while (LastLineEndInAtom>=1) and (not (NewAtom[LastLineEndInAtom] in [#10,#13]))
do dec(LastLineEndInAtom);
if (LastLineEndInAtom<1) and (CurLineLen+length(NewAtom)>LineLength)
and (LastSplitPos>0) then begin
//writeln('[TBeautifyCodeOptions.AddAtom] NEW LINE CurLineLen=',CurLineLen,' NewAtom=',NewAtom,' "',copy(s,LastSplitPos,5));
RestLineLen:=length(s)-LastSplitPos+1;
s:=copy(s,1,LastSplitPos-1)+LineEnd+IndentStr
+copy(s,LastSplitPos,RestLineLen)+NewAtom;
@ -578,7 +634,10 @@ begin
LastSplitPos:=-1;
end else begin
s:=s+NewAtom;
inc(CurLineLen,length(NewAtom));
if LastLineEndInAtom<1 then begin
inc(CurLineLen,length(NewAtom));
end else
CurLineLen:=length(NewAtom)-LastLineEndInAtom;
end;
end;
@ -724,13 +783,16 @@ begin
AddAtom(Result,LineEnd+LineEnd+IndentStr);
AddAtom(Result,'end;');
end;
{$IFDEF CTDEBUG}
writeln('[TBeautifyCodeOptions.BeautifyProc] Result="',Result,'"');
{$ENDIF}
end;
function TBeautifyCodeOptions.BeautifyStatement(const AStatement: string;
IndentSize: integer): string;
var CurAtom: string;
begin
//writeln('[TBeautifyCodeOptions.BeautifyStatement] ',AStatement);
Src:=AStatement;
UpperSrc:=UpperCaseStr(Src);
SrcLen:=length(Src);
@ -760,7 +822,7 @@ begin
AddAtom(Result,CurAtom);
LastAtomType:=CurAtomType;
end;
writeln('[TBeautifyCodeOptions.BeautifyStatement] Result="',Result,'"');
//writeln('[TBeautifyCodeOptions.BeautifyStatement] Result="',Result,'"');
end;
function TBeautifyCodeOptions.AddClassNameToProc(

136
components/codetools/sourcelog.pas
View File

@ -55,13 +55,17 @@ type
Position: integer;
Len: integer;
MoveTo: integer;
LineEnds: integer;
LineEnds: integer; // number of line ends in txt
LengthOfLastLine: integer;
Txt: string;
Operation: TSourceLogEntryOperation;
procedure AdjustPosition(var APosition: integer);
constructor Create(APos, ALength, AMoveTo: integer; const Txt: string;
constructor Create(APos, ALength, AMoveTo: integer; const ATxt: string;
AnOperation: TSourceLogEntryOperation);
end;
TOnSourceChange = procedure(Sender: TSourceLog; Entry: TSourceLogEntry)
of object;
TSourceLogMarker = class
private
@ -88,10 +92,13 @@ type
FOnInsert: TOnSourceLogInsert;
FOnDelete: TOnSourceLogDelete;
FOnMove: TOnSourceLogMove;
FChangeHooks: {$ifdef fpc}^{$else}array of {$endif}TOnSourceChange;
FChangeHookCount: integer;
FSource: string;
FChangeStep: integer;
FReadOnly: boolean;
FWriteLock: integer;
FChangeHookLock: integer;
procedure SetSource(const NewSrc: string);
function GetItems(Index: integer): TSourceLogEntry;
procedure SetItems(Index: integer; AnItem: TSourceLogEntry);
@ -99,6 +106,7 @@ type
procedure BuildLineRanges;
procedure IncreaseChangeStep;
procedure SetReadOnly(const Value: boolean);
function IndexOfChangeHook(AChangeHook: TOnSourceChange): integer;
public
Data: Pointer;
function LineCount: integer;
@ -115,6 +123,9 @@ type
procedure AddMarkerXY(Line, Column: integer; SomeData: Pointer);
procedure AdjustPosition(var APosition: integer);
procedure AdjustCursor(var Line, Column: integer);
procedure NotifyHooks(Entry: TSourceLogEntry);
procedure IncreaseHookLock;
procedure DecreaseHookLock;
property Source: string read FSource write SetSource;
property Modified: boolean read FModified write FModified;
// Line and Column begin at 1
@ -124,9 +135,6 @@ type
procedure Delete(Pos, Len: integer);
procedure Replace(Pos, Len: integer; const Txt: string);
procedure Move(Pos, Len, MoveTo: integer);
property OnInsert: TOnSourceLogInsert read FOnInsert write FOnInsert;
property OnDelete: TOnSourceLogDelete read FOnDelete write FOnDelete;
property OnMove: TOnSourceLogMove read FOnMove write FOnMove;
function LoadFromFile(const Filename: string): boolean; virtual;
function SaveToFile(const Filename: string): boolean; virtual;
function IsEqual(sl: TStrings): boolean;
@ -142,6 +150,12 @@ type
function ConsistencyCheck: integer;
constructor Create(const ASource: string);
destructor Destroy; override;
procedure AddChangeHook(AnOnSourceChange: TOnSourceChange);
procedure RemoveChangeHook(AnOnSourceChange: TOnSourceChange);
property OnInsert: TOnSourceLogInsert read FOnInsert write FOnInsert;
property OnDelete: TOnSourceLogDelete read FOnDelete write FOnDelete;
property OnMove: TOnSourceLogMove read FOnMove write FOnMove;
end;
@ -174,13 +188,14 @@ end;
{ TSourceLogEntry }
constructor TSourceLogEntry.Create(APos, ALength, AMoveTo: integer;
const Txt: string; AnOperation: TSourceLogEntryOperation);
const ATxt: string; AnOperation: TSourceLogEntryOperation);
begin
Position:=APos;
Len:=ALength;
MoveTo:=AMoveTo;
Operation:=AnOperation;
LineEnds:=LineEndCount(Txt, LengthOfLastLine);
Txt:=ATxt;
end;
procedure TSourceLogEntry.AdjustPosition(var APosition: integer);
@ -231,12 +246,18 @@ begin
FLineCount:=-1;
FChangeStep:=0;
Data:=nil;
FChangeHooks:=nil;
FChangeHookCount:=0;
FReadOnly:=false;
end;
destructor TSourceLog.Destroy;
begin
Clear;
if FChangeHooks<>nil then begin
FreeMem(FChangeHooks);
FChangeHooks:=nil;
end;
FMarkers.Free;
FLog.Free;
inherited Destroy;
@ -288,6 +309,7 @@ begin
IncreaseChangeStep;
Data:=nil;
FReadOnly:=false;
NotifyHooks(nil);
end;
function TSourceLog.GetItems(Index: integer): TSourceLogEntry;
@ -315,6 +337,26 @@ begin
Result:=fMarkers.Count;
end;
procedure TSourceLog.NotifyHooks(Entry: TSourceLogEntry);
var i: integer;
begin
if (FChangeHooks=nil) or (FChangeHookLock>0) then exit;
for i:=0 to FChangeHookCount-1 do
FChangeHooks[i](Self,Entry);
end;
procedure TSourceLog.IncreaseHookLock;
begin
inc(FChangeHookLock);
end;
procedure TSourceLog.DecreaseHookLock;
begin
if FChangeHookLock<=0 then exit;
dec(FChangeHookLock);
if FChangeHookLock=0 then NotifyHooks(nil);
end;
procedure TSourceLog.SetSource(const NewSrc: string);
begin
//writeln('TSourceLog.SetSource ',length(NewSrc));
@ -323,6 +365,7 @@ begin
FSource:=NewSrc;
FSrcLen:=length(FSource);
FReadOnly:=false;
NotifyHooks(nil);
end;
end;
@ -330,14 +373,15 @@ procedure TSourceLog.Insert(Pos: integer; const Txt: string);
var i: integer;
NewSrcLogEntry: TSourceLogEntry;
begin
if Txt='' then exit;
if Assigned(FOnInsert) then FOnInsert(Self,Pos,Txt);
NewSrcLogEntry:=TSourceLogEntry.Create(Pos,length(Txt),-1,Txt,sleoInsert);
FLog.Add(NewSrcLogEntry);
NotifyHooks(NewSrcLogEntry);
FSource:=copy(FSource,1,Pos-1)
+Txt
+copy(FSource,Pos,length(FSource)-Pos+1);
FSrcLen:=length(FSource);
writeln('TSourceLog.Insert ',fSrcLen);
NewSrcLogEntry:=TSourceLogEntry.Create(Pos,length(Txt),-1,Txt,sleoInsert);
FLog.Add(NewSrcLogEntry);
for i:=0 to FMarkers.Count-1 do begin
if (not Markers[i].Deleted) then
NewSrcLogEntry.AdjustPosition(Markers[i].NewPosition);
@ -351,12 +395,13 @@ procedure TSourceLog.Delete(Pos, Len: integer);
var i: integer;
NewSrcLogEntry: TSourceLogEntry;
begin
if Len=0 then exit;
if Assigned(FOnDelete) then FOnDelete(Self,Pos,Len);
System.Delete(FSource,Pos,Len);
FSrcLen:=length(FSource);
writeln('TSourceLog.Delete ',fSrcLen,',',length(fSource));
NewSrcLogEntry:=TSourceLogEntry.Create(Pos,Len,-1,'',sleoDelete);
FLog.Add(NewSrcLogEntry);
NotifyHooks(NewSrcLogEntry);
System.Delete(FSource,Pos,Len);
FSrcLen:=length(FSource);
for i:=0 to FMarkers.Count-1 do begin
if (Markers[i].Deleted=false) then begin
if (Markers[i].NewPosition<=Pos) and (Markers[i].NewPosition<Pos+Len) then
@ -375,17 +420,24 @@ procedure TSourceLog.Replace(Pos, Len: integer; const Txt: string);
var i: integer;
DeleteSrcLogEntry, InsertSrcLogEntry: TSourceLogEntry;
begin
if (Len=0) and (Txt='') then exit;
if Len=length(Txt) then begin
i:=1;
while (i<=Len) and (FSource[Pos+i-1]=Txt[i]) do inc(i);
if i>Len then exit;
end;
if Assigned(FOnDelete) then FOnDelete(Self,Pos,Len);
if Assigned(FOnInsert) then FOnInsert(Self,Pos,Txt);
DeleteSrcLogEntry:=TSourceLogEntry.Create(Pos,Len,-1,'',sleoDelete);
FLog.Add(DeleteSrcLogEntry);
NotifyHooks(DeleteSrcLogEntry);
InsertSrcLogEntry:=TSourceLogEntry.Create(Pos,length(Txt),-1,Txt,sleoInsert);
FLog.Add(InsertSrcLogEntry);
NotifyHooks(InsertSrcLogEntry);
FSource:=copy(FSource,1,Pos-1)
+Txt
+copy(FSource,Pos+Len,length(FSource)-Pos-Len+1);
FSrcLen:=length(FSource);
writeln('TSourceLog.Replace ',fSrcLen,',',length(fSource));
DeleteSrcLogEntry:=TSourceLogEntry.Create(Pos,Len,-1,'',sleoDelete);
FLog.Add(DeleteSrcLogEntry);
InsertSrcLogEntry:=TSourceLogEntry.Create(Pos,length(Txt),-1,Txt,sleoInsert);
FLog.Add(InsertSrcLogEntry);
for i:=0 to FMarkers.Count-1 do begin
if (Markers[i].Deleted=false) then begin
if (Markers[i].NewPosition<=Pos) and (Markers[i].NewPosition<Pos+Len) then
@ -407,6 +459,9 @@ var i: integer;
begin
if Assigned(FOnMove) then FOnMove(Self,Pos,Len,MoveTo);
if (MoveTo>=Pos) and (MoveTo<Pos+Len) then exit;
NewSrcLogEntry:=TSourceLogEntry.Create(Pos,Len,MoveTo,'',sleoMove);
FLog.Add(NewSrcLogEntry);
NotifyHooks(NewSrcLogEntry);
if MoveTo<Pos then begin
FSource:=copy(FSource,1,MoveTo-1)
+copy(FSource,Pos,Len)
@ -419,9 +474,6 @@ begin
+copy(FSource,MoveTo,length(FSource)-MoveTo+1);
end;
FSrcLen:=length(FSource);
writeln('TSourceLog.Move ',fSrcLen,',',length(fSource));
NewSrcLogEntry:=TSourceLogEntry.Create(Pos,Len,MoveTo,'',sleoMove);
FLog.Add(NewSrcLogEntry);
for i:=0 to FMarkers.Count-1 do begin
if (Markers[i].Deleted=false) then
NewSrcLogEntry.AdjustPosition(Markers[i].NewPosition);
@ -468,7 +520,8 @@ begin
if p>0 then begin
AdjustPosition(p);
AbsoluteToLineCol(p,Line,Column);
end;
end else
Line:=-1;
end;
procedure TSourceLog.BuildLineRanges;
@ -661,6 +714,7 @@ var y,p,LineLen: integer;
begin
if sl=nil then exit;
if IsEqual(sl) then exit;
IncreaseHookLock;
Clear;
fSrcLen:=sl.Count*2;
for y:=0 to sl.Count-1 do inc(fSrcLen,length(sl[y]));
@ -679,6 +733,7 @@ begin
fSource[p]:=#10;
inc(p);
end;
DecreaseHookLock;
end;
procedure TSourceLog.AssignTo(sl: TStrings);
@ -703,14 +758,16 @@ end;
procedure TSourceLog.LoadFromStream(s: TStream);
begin
IncreaseHookLock;
Clear;
if s=nil then exit;
s.Position:=0;
fSrcLen:=s.Size;
fSrcLen:=s.Size-s.Position;
if fSrcLen>0 then begin
SetLength(fSource,fSrcLen);
s.Read(fSource[1],fSrcLen);
end;
DecreaseHookLock;
end;
procedure TSourceLog.SaveToStream(s: TStream);
@ -741,5 +798,40 @@ begin
Result:=0;
end;
function TSourceLog.IndexOfChangeHook(AChangeHook: TOnSourceChange): integer;
begin
Result:=FChangeHookCount-1;
while (Result>=0) and (FChangeHooks[Result]<>AChangeHook) do dec(Result);
end;
procedure TSourceLog.AddChangeHook(AnOnSourceChange: TOnSourceChange);
var i: integer;
begin
i:=IndexOfChangeHook(AnOnSourceChange);
if i>=0 then exit;
inc(FChangeHookCount);
if FChangeHooks=nil then
GetMem(FChangeHooks, SizeOf(TOnSourceChange))
else
ReallocMem(FChangeHooks, SizeOf(TOnSourceChange) * FChangeHookCount);
FChangeHooks[FChangeHookCount-1]:=AnOnSourceChange;
end;
procedure TSourceLog.RemoveChangeHook(AnOnSourceChange: TOnSourceChange);
var i,j: integer;
begin
i:=IndexOfChangeHook(AnOnSourceChange);
if i<0 then exit;
dec(FChangeHookCount);
if FChangeHookCount=1 then
FreeMem(FChangeHooks)
else begin
for j:=i to FChangeHookCount-2 do
FChangeHooks[j]:=FChangeHooks[j+1];
ReAllocMem(FChangeHooks,SizeOf(TOnSourceChange) * FChangeHookCount);
end;
end;
end.

11
ide/lazarus.pp
View File

@ -24,11 +24,16 @@ program lazarus;
{$mode objfpc}{$H+}
{$I ide.inc}
{$IFDEF SUPPORTS_RESOURCES}
{$R *.res}
{$ENDIF}
uses
{$IFDEF IDE_MEM_CHECK}
MemCheck,
{$ENDIF}
Forms,
Splash,
Main,
@ -51,6 +56,9 @@ begin
end;
Application.CreateForm(TMainIDE, MainIDE);
{$IFDEF IDE_MEM_CHECK}
CheckHeap('TMainIDE created');
{$ENDIF}
Application.CreateForm(TMessagesView, MessagesView);
Application.CreateForm(TLazFindReplaceDialog, FindReplaceDlg);
SplashForm.StartTimer;
@ -63,6 +71,9 @@ end.
{
$Log$
Revision 1.21 2001/10/15 13:11:27 lazarus
MG: added complete code
Revision 1.20 2001/08/02 12:58:35 lazarus
MG: win32 interface patch from Keith Bowes

622
ide/main.pp
View File

@ -200,12 +200,14 @@ type
// CodeToolBoss events
procedure OnBeforeCodeToolBossApplyChanges(Manager: TCodeToolManager;
var Abort: boolean);
procedure OnAfterCodeToolBossApplyChanges(Manager: TCodeToolManager);
private
FCodeLastActivated : Boolean; //used for toggling between code and forms
FSelectedComponent : TRegisteredComponent;
fProject: TProject;
MacroList: TTransferMacroList;
FMessagesViewBoundsRectValid: boolean;
FOpenEditorsOnCodeToolChange: boolean;
Function CreateSeperator : TMenuItem;
Procedure SetDefaultsForForm(aForm : TCustomForm);
@ -565,8 +567,13 @@ CheckHeap(IntToStr(GetMem_Cnt));
else if (EnvironmentOptions.OpenLastprojectAtStart)
and (FileExists(EnvironmentOptions.LastSavedProjectFile))
and (DoOpenProjectFile(EnvironmentOptions.LastSavedProjectFile)=mrOk) then
begin
// last project loaded
else
writeln('TMainIDE.Create last project loaded successfully');
{$IFDEF IDE_MEM_CHECK}
CheckHeap(IntToStr(GetMem_Cnt));
{$ENDIF}
end else
// create new project
DoNewProject(ptApplication);
@ -1459,9 +1466,13 @@ end;
Procedure TMainIDE.SetDefaultsforForm(aForm : TCustomForm);
Begin
{$IFDEF IDE_DEBUG}
writeln('[TMainIDE.SetDefaultsforForm] A');
{$ENDIF}
aForm.Designer := TDesigner.Create(aForm, TheControlSelection);
{$IFDEF IDE_DEBUG}
writeln('[TMainIDE.SetDefaultsforForm] B');
{$ENDIF}
with TDesigner(aForm.Designer) do begin
FormEditor := FormEditor1;
OnGetSelectedComponentClass:=@OnDesignerGetSelectedComponentClass;
@ -1484,9 +1495,13 @@ var CanClose: boolean;
begin
CanClose:=true;
OnCloseQuery(Sender, CanClose);
{$IFDEF IDE_DEBUG}
writeln('TMainIDE.mnuQuitClicked 1');
{$ENDIF}
if CanClose then Close;
{$IFDEF IDE_DEBUG}
writeln('TMainIDE.mnuQuitClicked 2');
{$ENDIF}
end;
{------------------------------------------------------------------------------}
@ -1843,7 +1858,7 @@ CheckHeap(IntToStr(GetMem_Cnt));
exit;
end;
if ActiveSrcEdit.Modified then begin
ActiveUnitInfo.Source.Assign(ActiveSrcEdit.Source);
ActiveSrcEdit.UpdateCodeBuffer;
ActiveUnitInfo.Modified:=true;
end;
if (not SaveToTestDir) and (ActiveUnitInfo.Source.IsVirtual) then
@ -1857,11 +1872,15 @@ CheckHeap(IntToStr(GetMem_Cnt));
if ActiveUnitInfo.HasResources then begin
LinkIndex:=-1;
{$IFDEF IDE_DEBUG}
writeln('TMainIDE.DoSaveEditorUnit B');
CodeToolBoss.SourceCache.WriteAllFileNames;
{$ENDIF}
ResourceCode:=CodeToolBoss.FindNextResourceFile(
ActiveUnitInfo.Source,LinkIndex);
{$IFDEF IDE_DEBUG}
writeln('TMainIDE.DoSaveEditorUnit B2 ',ResourceCode<>nil);
{$ENDIF}
if ResourceCode<>nil then
LFMCode:=
CodeToolBoss.LoadFile(ChangeFileExt(ResourceCode.Filename,'.lfm'))
@ -1891,32 +1910,33 @@ writeln('TMainIDE.DoSaveEditorUnit B2 ',ResourceCode<>nil);
EnvironmentOptions.AddToRecentOpenFiles(NewFilename);
if not CodeToolBoss.SaveBufferAs(ActiveUnitInfo.Source,NewFilename,
NewSource) then exit;
writeln('TMainIDE.DoSaveEditorUnit C ',ResourceCode<>nil);
if ResourceCode<>nil then begin
// rename Resource file and form text file
// the resource include line in the code will be changed later
CodeToolBoss.SaveBufferAs(ResourceCode,
ChangeFileExt(NewFilename,ResourceFileExt),ResourceCode);
LinkIndex:=-1;
ResourceCode:=CodeToolBoss.FindNextResourceFile(NewSource,LinkIndex);
{$IFDEF IDE_DEBUG}
writeln('TMainIDE.DoSaveEditorUnit D ',ResourceCode<>nil);
if ResourceCode<>nil then writeln('*** ResourceFileName ',ResourceCode.Filename);
{$ENDIF}
if LFMCode<>nil then begin
if not CodeToolBoss.SaveBufferAs(LFMCode,
ChangeFileExt(NewFilename,'.lfm'),LFMCode) then
LFMCode:=nil;
end;
end;
{$IFDEF IDE_DEBUG}
writeln('TMainIDE.DoSaveEditorUnit C ',ResourceCode<>nil);
{$ENDIF}
ActiveUnitInfo.Source:=NewSource;
ActiveUnitInfo.Modified:=false;
NewUnitName:=ExtractFileName(ActiveUnitInfo.Filename);
NewUnitName:=ChangeFileExt(NewUnitName,'');
// change unitname in source
if ActiveUnitInfo.UnitName<>NewUnitName then begin
ActiveUnitInfo.UnitName:=NewUnitName;
ActiveUnitInfo.Source.AssignTo(ActiveSrcEdit.Source);
end;
ActiveSrcEdit.CodeBuffer:=NewSource; // the code is not changed, thus the marks are kept
NewUnitName:=ExtractFileNameOnly(ActiveUnitInfo.Filename);
// change unitname in source (resource filename is also changed)
ActiveUnitInfo.UnitName:=NewUnitName;
// change unitname on SourceNotebook
ActiveSrcEdit.Filename:=ActiveUnitInfo.Filename;
NewPageName:=SourceNoteBook.FindUniquePageName(
ActiveUnitInfo.Filename,SourceNoteBook.NoteBook.PageIndex);
SourceNoteBook.NoteBook.Pages[SourceNoteBook.NoteBook.PageIndex]:=
@ -1956,7 +1976,9 @@ if ResourceCode<>nil then writeln('*** ResourceFileName ',ResourceCode.Filename)
end;
end;
{$IFDEF IDE_DEBUG}
writeln('*** HasResources=',ActiveUnitInfo.HasResources);
{$ENDIF}
{$IFDEF IDE_MEM_CHECK}
CheckHeap(IntToStr(GetMem_Cnt));
{$ENDIF}
@ -2002,7 +2024,9 @@ CheckHeap(IntToStr(GetMem_Cnt));
finally
MemStream.Free;
end;
{$IFDEF IDE_DEBUG}
writeln('TMainIDE.DoSaveEditorUnit E ',CompResourceCode);
{$ENDIF}
// replace lazarus form resource code
if not CodeToolBoss.AddLazarusResource(ResourceCode,
'T'+ActiveUnitInfo.FormName,CompResourceCode) then
@ -2016,7 +2040,9 @@ writeln('TMainIDE.DoSaveEditorUnit E ',CompResourceCode);
if Result=mrCancel then Result:=mrAbort;
exit;
end;
{$IFDEF IDE_DEBUG}
writeln('TMainIDE.DoSaveEditorUnit F ',ResourceCode.Modified);
{$ENDIF}
if not SaveToTestDir then begin
if ResourceCode.Modified then begin
Result:=DoSaveCodeBufferToFile(ResourceCode,ResourceCode.Filename,
@ -2031,7 +2057,9 @@ writeln('TMainIDE.DoSaveEditorUnit F ',ResourceCode.Modified);
if not Result=mrOk then exit;
Result:=mrCancel;
end;
{$IFDEF IDE_DEBUG}
writeln('TMainIDE.DoSaveEditorUnit G ',LFMCode<>nil);
{$ENDIF}
if (not SaveToTestDir) and (LFMCode<>nil) then begin
repeat
try
@ -2070,6 +2098,7 @@ writeln('TMainIDE.DoSaveEditorUnit G ',LFMCode<>nil);
ActiveUnitInfo.Modified:=false;
ActiveSrcEdit.Modified:=false;
end;
SourceNoteBook.UpdateStatusBar;
writeln('TMainIDE.DoSaveEditorUnit END');
Result:=mrOk;
end;
@ -2078,7 +2107,7 @@ function TMainIDE.DoCloseEditorUnit(PageIndex:integer;
SaveFirst: boolean):TModalResult;
var ActiveSrcEdit: TSourceEditor;
ActiveUnitInfo: TUnitInfo;
ACaption,AText:string;
ACaption,AText: string;
i:integer;
OldDesigner: TDesigner;
begin
@ -2153,12 +2182,6 @@ CheckHeap(IntToStr(GetMem_Cnt));
Result:=mrCancel;
if AFileName='' then exit;
Ext:=lowercase(ExtractFileExt(AFilename));
if (not ProjectLoading) and (ToolStatus=itNone)
and ((Ext='.lpi') or (Ext='.lpr')) then begin
// load program file and project info file
Result:=DoOpenProjectFile(AFilename);
exit;
end;
// check if the project knows this file
i:=Project.UnitCount-1;
while (i>=0) and (Project.Units[i].Filename<>AFileName) do dec(i);
@ -2177,6 +2200,12 @@ CheckHeap(IntToStr(GetMem_Cnt));
if (Ext='.pp') or (Ext='.pas') then
NewUnitInfo.ReadUnitNameFromSource;
end else begin
if (not ProjectLoading) and (ToolStatus=itNone)
and ((Ext='.lpi') or (Ext='.lpr')) then begin
// load program file and project info file
Result:=DoOpenProjectFile(AFilename);
exit;
end;
Result:=DoLoadCodeBuffer(PreReadBuf,AFileName);
if Result<>mrOk then exit;
Result:=mrCancel;
@ -2218,11 +2247,12 @@ CheckHeap(IntToStr(GetMem_Cnt));
NewUnitInfo.ReadUnitNameFromSource;
Project.AddUnit(NewUnitInfo,false);
end;
{$IFDEF IDEDEBUG}
{$IFDEF IDE_DEBUG}
writeln('[TMainIDE.DoOpenEditorFile] B');
{$ENDIF}
// create a new source editor
NewUnitInfo.SyntaxHighlighter:=ExtensionToLazSyntaxHighlighter(Ext);
writeln('[TMainIDE.DoOpenEditorFile] B2');
NewPageName:=NewUnitInfo.UnitName;
if NewPageName='' then begin
NewPageName:=ExtractFileName(AFilename);
@ -2230,7 +2260,9 @@ writeln('[TMainIDE.DoOpenEditorFile] B');
NewPageName:=copy(NewPageName,1,length(NewPageName)-length(Ext));
if NewpageName='' then NewPageName:='file';
end;
writeln('[TMainIDE.DoOpenEditorFile] B3');
SourceNotebook.NewFile(NewPageName,NewUnitInfo.Source);
writeln('*** TMainIDE.DoOpenEditorFile C');
NewSrcEdit:=SourceNotebook.GetActiveSE;
if not ProjectLoading then
Project.InsertEditorIndex(SourceNotebook.NoteBook.PageIndex)
@ -2253,9 +2285,8 @@ writeln('[TMainIDE.DoOpenEditorFile] B');
NewSrcEdit.EditorComponent.CaretXY:=NewUnitInfo.CursorPos;
NewSrcEdit.EditorComponent.TopLine:=NewUnitInfo.TopLine;
NewSrcEdit.EditorComponent.LeftChar:=1;
NewSrcEdit.Filename:=NewUnitInfo.Filename;
{$IFDEF IDEDEBUG}
{$IFDEF IDE_DEBUG}
writeln('[TMainIDE.DoOpenEditorFile] C');
{$ENDIF}
NewUnitInfo.Loaded:=true;
@ -2292,8 +2323,9 @@ writeln('[TMainIDE.DoOpenEditorFile] C');
except
on E: Exception do begin
ACaption:='Format error';
AText:='Unable to convert text form data of file "'
+NewBuf.Filename+'" into binary stream. ('+E.Message+')';
AText:='Unable to convert text form data of file '#13
+'"'+NewBuf.Filename+'"'#13
+'into binary stream. ('+E.Message+')';
Result:=MessageDlg(ACaption, AText, mterror, [mbok, mbcancel], 0);
if Result=mrCancel then Result:=mrAbort;
if Result<>mrOk then exit;
@ -2311,8 +2343,8 @@ writeln('[TMainIDE.DoOpenEditorFile] C');
FormEditor1.CreateFormFromStream(BinLFMStream));
if CInterface=nil then begin
ACaption:='Form load error';
AText:='Unable to build form from file "'
+NewBuf.Filename+'".';
AText:='Unable to build form from file '#13
+'"'+NewBuf.Filename+'".';
Result:=MessageDlg(ACaption, AText, mterror, [mbok, mbcancel], 0);
if Result=mrCancel then Result:=mrAbort;
if Result<>mrOk then exit;
@ -2335,7 +2367,7 @@ writeln('[TMainIDE.DoOpenEditorFile] C');
PropertyEditorHook1.LookupRoot := TForm(CInterface.Control);
TDesigner(TempForm.Designer).SelectOnlyThisComponent(TempForm);
end;
{$IFDEF IDEDEBUG}
{$IFDEF IDE_DEBUG}
writeln('[TMainIDE.DoOpenEditorFile] LFM end');
{$ENDIF}
finally
@ -2356,7 +2388,7 @@ var MainUnitInfo: TUnitInfo;
NewPageName, Ext: string;
NewSrcEdit: TSourceEditor;
begin
//writeln('[TMainIDE.DoOpenMainUnit] A');
writeln('[TMainIDE.DoOpenMainUnit] A');
Result:=mrCancel;
if Project.MainUnit<0 then exit;
MainUnitInfo:=Project.Units[Project.MainUnit];
@ -2388,7 +2420,7 @@ begin
NewSrcEdit.EditorComponent.CaretXY:=MainUnitInfo.CursorPos;
NewSrcEdit.EditorComponent.TopLine:=MainUnitInfo.TopLine;
Result:=mrOk;
//writeln('[TMainIDE.DoOpenMainUnit] END');
writeln('[TMainIDE.DoOpenMainUnit] END');
end;
function TMainIDE.DoViewUnitsAndForms(OnlyForms: boolean): TModalResult;
@ -2471,7 +2503,7 @@ begin
writeln('TMainIDE.DoOpenFileAtCursor');
Result:=mrCancel;
// ToDo
// check if include, unit, or simply a filename
// check if include, unit, or simply a filename (in a string or comment)
end;
function TMainIDE.DoNewProject(NewProjectType:TProjectType):TModalResult;
@ -2570,8 +2602,7 @@ writeln('TMainIDE.DoSaveProject A SaveAs=',SaveAs,' SaveToTestDir=',SaveToTestDi
MainUnitSrcEdit:=SourceNoteBook.FindSourceEditorWithPageIndex(
MainUnitInfo.EditorIndex);
if MainUnitSrcEdit.Modified then begin
MainUnitInfo.Source.Assign(MainUnitSrcEdit.Source);
writeln(' >>> ',MainUnitInfo.Source.SourceLength);
MainUnitSrcEdit.UpdateCodeBuffer;
MainUnitInfo.Modified:=true;
end;
end;
@ -2598,7 +2629,6 @@ writeln(' >>> ',MainUnitInfo.Source.SourceLength);
end;
end;
writeln(' AAA ',Project.ProjectFile);
SaveAs:=SaveAs or (Project.ProjectFile='');
if SaveAs and (not SaveToTestDir) then begin
// let user choose a filename
@ -2643,8 +2673,9 @@ writeln(' AAA ',Project.ProjectFile);
end else if Project.ProjectType in [ptProgram, ptApplication] then begin
if FileExists(NewProgramFilename) then begin
ACaption:='Overwrite file?';
AText:='A file "'+NewProgramFilename+'" already exists.'#13'Replace it?';
Result:=MessageDlg(ACaption, AText, mtconfirmation, [mbok, mbcancel], 0);
AText:='A file "'+NewProgramFilename+'" already exists.'#13
+'Replace it?';
Result:=MessageDlg(ACaption, AText, mtconfirmation,[mbOk,mbCancel],0);
if Result=mrCancel then exit;
end;
end;
@ -2660,13 +2691,12 @@ writeln(' AAA ',Project.ProjectFile);
end;
NewBuf.Source:=MainUnitInfo.Source.Source;
MainUnitInfo.Source:=NewBuf;
MainUnitSrcEdit.CodeBuffer:=NewBuf;
// change program name
NewProgramName:=ExtractFileNameOnly(NewProgramFilename);
CodeToolBoss.RenameSource(MainUnitInfo.Source,NewProgramName);
// update source editor of main unit
MainUnitInfo.Source.AssignTo(MainUnitSrcEdit.Source);
MainUnitInfo.Modified:=true;
MainUnitSrcEdit.Filename:=MainUnitInfo.Filename;
NewPageName:=ExtractFileName(MainUnitInfo.Filename);
Ext:=ExtractFileExt(NewPagename);
if (Ext='.pp') or (Ext='.pas') then
@ -2788,7 +2818,7 @@ CheckHeap(IntToStr(GetMem_Cnt));
Result:=DoCloseProject;
if Result=mrAbort then exit;
// create a new one
//writeln('TMainIDE.DoOpenProjectFile B');
writeln('TMainIDE.DoOpenProjectFile B');
{$IFDEF IDE_MEM_CHECK}
CheckHeap(IntToStr(GetMem_Cnt));
{$ENDIF}
@ -2801,7 +2831,7 @@ CheckHeap(IntToStr(GetMem_Cnt));
if Result in [mrAbort,mrIgnore] then exit;
Project.Units[Project.MainUnit].Source:=NewBuf;
end;
//writeln('TMainIDE.DoOpenProjectFile C');
writeln('TMainIDE.DoOpenProjectFile C');
{$IFDEF IDE_MEM_CHECK}
CheckHeap(IntToStr(GetMem_Cnt));
{$ENDIF}
@ -2846,7 +2876,7 @@ writeln('TMainIDE.DoOpenProjectFile D');
EnvironmentOptions.LastSavedProjectFile:=Project.ProjectInfoFile;
EnvironmentOptions.Save(false);
Result:=mrOk;
writeln('TMainIDE.DoOpenProjectFile end ',CodeToolBoss.ConsistencyCheck);
writeln('TMainIDE.DoOpenProjectFile end CodeToolBoss.ConsistencyCheck=',CodeToolBoss.ConsistencyCheck);
{$IFDEF IDE_MEM_CHECK}
CheckHeap(IntToStr(GetMem_Cnt));
{$ENDIF}
@ -3630,6 +3660,246 @@ begin
Result:=TestDir+Result+'.lpr';
end;
//------------------------------------------------------------------------------
procedure TMainIDE.OnDesignerGetSelectedComponentClass(Sender: TObject;
var RegisteredComponent: TRegisteredComponent);
begin
RegisteredComponent:=SelectedComponent;
end;
procedure TMainIDE.OnDesignerUnselectComponentClass(Sender: TObject);
begin
ControlClick(ComponentNoteBook);
end;
procedure TMainIDE.OnDesignerSetDesigning(Sender: TObject;
Component: TComponent; Value: boolean);
begin
SetDesigning(Component,Value);
end;
procedure TMainIDE.OnDesignerComponentListChanged(Sender: TObject);
begin
ObjectInspector1.FillComponentComboBox;
end;
procedure TMainIDE.OnDesignerPropertiesChanged(Sender: TObject);
begin
ObjectInspector1.RefreshPropertyValues;
end;
procedure TMainIDE.OnDesignerAddComponent(Sender: TObject;
Component: TComponent; ComponentClass: TRegisteredComponent);
var i: integer;
ActiveForm: TCustomForm;
ActiveUnitInfo: TUnitInfo;
FormClassName: string;
begin
ActiveForm:=TDesigner(Sender).Form;
if ActiveForm=nil then begin
writeln('[TMainIDE.OnDesignerAddComponent] Error: TDesigner without a form');
halt;
end;
// find source for form
i:=Project.UnitCount-1;
while (i>=0) do begin
if (Project.Units[i].Loaded)
and (Project.Units[i].Form=ActiveForm) then break;
dec(i);
end;
if i<0 then begin
writeln('[TMainIDE.OnDesignerAddComponent] Error: form without source');
halt;
end;
ActiveUnitInfo:=Project.Units[i];
// add needed unit to source
CodeToolBoss.AddUnitToMainUsesSection(ActiveUnitInfo.Source,
ComponentClass.UnitName,'');
// add component definition to form source
FormClassName:=ActiveForm.ClassName;
if CodeToolBoss.PublishedVariableExists(ActiveUnitInfo.Source,'*',
FormClassName) then begin
CodeToolBoss.AddPublishedVariable(ActiveUnitInfo.Source,FormClassName,
Component.Name, Component.ClassName);
end;
end;
procedure TMainIDE.OnDesignerRemoveComponent(Sender: TObject;
Component: TComponent);
var i: integer;
ActiveForm: TCustomForm;
ActiveUnitInfo: TUnitInfo;
FormClassName: string;
begin
ActiveForm:=TDesigner(Sender).Form;
if ActiveForm=nil then begin
writeln('[TMainIDE.OnDesignerAddComponent] Error: TDesigner without a form');
halt;
end;
// find source for form
i:=Project.UnitCount-1;
while (i>=0) do begin
if (Project.Units[i].Loaded)
and (Project.Units[i].Form=ActiveForm) then break;
dec(i);
end;
if i<0 then begin
writeln('[TMainIDE.OnDesignerAddComponent] Error: form without source');
halt;
end;
ActiveUnitInfo:=Project.Units[i];
// remove component definition to form source
FormClassName:=ActiveForm.ClassName;
if CodeToolBoss.RemovePublishedVariable(ActiveUnitInfo.Source,FormClassName,
Component.Name) then begin
ActiveUnitInfo.Modified:=true;
end;
end;
procedure TMainIDE.OnDesignerModified(Sender: TObject);
var i: integer;
begin
i:=Project.IndexOfUnitWithForm(TDesigner(Sender).Form,false);
if i>=0 then begin
Project.Units[i].Modified:=true;
if Project.Units[i].Loaded then
SourceNotebook.FindSourceEditorWithPageIndex(
Project.Units[i].EditorIndex).EditorComponent.Modified:=true;
end;
end;
procedure TMainIDE.OnControlSelectionChanged(Sender: TObject);
var NewSelectedComponents : TComponentSelectionList;
i: integer;
begin
writeln('[TMainIDE.OnControlSelectionChanged]');
if (TheControlSelection=nil) or (FormEditor1=nil) then exit;
NewSelectedComponents:=TComponentSelectionList.Create;
for i:=0 to TheControlSelection.Count-1 do begin
NewSelectedComponents.Add(TheControlSelection[i].Component);
end;
FormEditor1.SelectedComponents:=NewSelectedComponents;
NewSelectedComponents.Free;
writeln('[TMainIDE.OnControlSelectionChanged] END');
end;
// -----------------------------------------------------------------------------
procedure TMainIDE.InitCodeToolBoss;
// initialize the CodeToolBoss, which is the frontend for the codetools.
// - sets a basic set of compiler macros
// ToDo: build a frontend for the codetools and save the settings
var CompilerUnitSearchPath: string;
ADefTempl: TDefineTemplate;
c: integer;
begin
FOpenEditorsOnCodeToolChange:=false;
if (not FileExists(EnvironmentOptions.CompilerFilename)) then begin
writeln('');
writeln('Warning *: Compiler Filename not set! (see Environment Options)');
end;
if (EnvironmentOptions.LazarusDirectory='') then begin
writeln('');
writeln(
'Warning *: Lazarus Source Directory not set! (see Environment Options)');
end;
if (EnvironmentOptions.FPCSourceDirectory='') then begin
writeln('');
writeln(
'Warning: FPC Source Directory not set! (see Environment Options)');
end;
// set global variables
with CodeToolBoss.GlobalValues do begin
Variables[ExternalMacroStart+'LazarusSrcDir']:=
EnvironmentOptions.LazarusDirectory;
Variables[ExternalMacroStart+'FPCSrcDir']:=
EnvironmentOptions.FPCSourceDirectory;
Variables[ExternalMacroStart+'LCLWidgetType']:='gtk';
Variables[ExternalMacroStart+'ProjectDir']:='';
end;
// build DefinePool and Define Tree
with CodeToolBoss.DefinePool do begin
// start the compiler and ask for his settings
ADefTempl:=CreateFPCTemplate(EnvironmentOptions.CompilerFilename,
CompilerUnitSearchPath);
if ADefTempl=nil then begin
writeln('');
writeln(
'Warning: Could not create Define Template for Free Pascal Compiler');
end;
Add(ADefTempl);
CodeToolBoss.DefineTree.Add(ADefTempl.CreateCopy);
// create compiler macros to simulate the Makefiles of the FPC sources
ADefTempl:=CreateFPCSrcTemplate(EnvironmentOptions.FPCSourceDirectory,
CompilerUnitSearchPath);
if ADefTempl=nil then begin
writeln('');
writeln(
'Warning: Could not create Define Template for Free Pascal Sources');
end;
Add(ADefTempl);
CodeToolBoss.DefineTree.Add(ADefTempl.CreateCopy);
// create compilr macros for the lazarus sources
ADefTempl:=CreateLazarusSrcTemplate('$(#LazarusSrcDir)','$(#LCLWidgetType)');
if ADefTempl=nil then begin
writeln('');
writeln(
'Warning: Could not create Define Template for Lazarus Sources');
end;
Add(ADefTempl);
CodeToolBoss.DefineTree.Add(ADefTempl.CreateCopy);
end;
// build define tree
with CodeToolBoss do begin
DefineTree.Add(DefinePool.CreateLCLProjectTemplate(
'$(#LazarusSrcDir)','$(#LCLWidgetType)','$(#ProjectDir)'));
//DefineTree.WriteDebugReport;
end;
c:=CodeToolBoss.ConsistencyCheck;
if c<>0 then begin
writeln('CodeToolBoss.ConsistencyCheck=',c);
Halt;
end;
with CodeToolBoss do begin
WriteExceptions:=true;
CatchExceptions:=true;
OnBeforeApplyChanges:=@OnBeforeCodeToolBossApplyChanges;
OnAfterApplyChanges:=@OnAfterCodeToolBossApplyChanges;
end;
end;
procedure TMainIDE.OnBeforeCodeToolBossApplyChanges(Manager: TCodeToolManager;
var Abort: boolean);
// the CodeToolBoss built a list of Sources that will be modified
// 1. open all of them in the source notebook
// 2. lock the editors to reduce repaints and undo steps
var i: integer;
begin
if FOpenEditorsOnCodeToolChange then begin
// open all sources in editor
for i:=0 to Manager.SourceChangeCache.BuffersToModifyCount-1 do begin
if DoOpenEditorFile(Manager.SourceChangeCache.BuffersToModify[i].Filename,
false)<>mrOk then
begin
Abort:=true;
exit;
end;
end;
end;
// lock all editors
SourceNoteBook.LockAllEditorsInSourceChangeCache;
end;
procedure TMainIDE.OnAfterCodeToolBossApplyChanges(Manager: TCodeToolManager);
begin
SourceNoteBook.UnlockAllEditorsInSourceChangeCache;
end;
procedure TMainIDE.SaveSourceEditorChangesToCodeCache;
// save all open sources to code tools cache
var i: integer;
@ -3642,38 +3912,17 @@ begin
SrcEdit:=SourceNotebook.FindSourceEditorWithPageIndex(
CurUnitInfo.EditorIndex);
if SrcEdit.Modified then begin
CurUnitInfo.Source.Assign(SrcEdit.Source);
SrcEdit.UpdateCodeBuffer;
CurUnitInfo.Modified:=true;
SrcEdit.Modified:=false;
end;
end;
end;
end;
procedure TMainIDE.ApplyCodeToolChanges;
// reload all loaded project sources from code tools cache
// moves marks (bookmarks, breakpoint, ToDo: goto history)
var i: integer;
AnUnitInfo: TUnitInfo;
SrcEdit: TSourceEditor;
begin
if Project=nil then exit;
for i:=0 to Project.UnitCount-1 do begin
AnUnitInfo:=Project.Units[i];
if AnUnitInfo.Source.Count>0 then begin
// source has changed
if AnUnitInfo.EditorIndex>=0 then begin
// source is loaded in editor
SrcEdit:=SourceNotebook.FindSourceEditorWithPageIndex(
AnUnitInfo.EditorIndex);
SrcEdit.AdjustMarksByCodeCache;
// apply source
AnUnitInfo.Source.AssignTo(SrcEdit.EditorComponent.Lines);
SrcEdit.EditorComponent.Modified:=true;
end;
AnUnitInfo.Source.ClearEntries;
end;
end;
// all changes were handled automatically by events
// just clear the logs
CodeToolBoss.SourceCache.ClearAllSourleLogEntries;
end;
@ -3689,7 +3938,7 @@ begin
if (ActiveSrcEdit=nil) or (ActiveUnitInfo=nil) then exit;
SaveSourceEditorChangesToCodeCache;
CodeToolBoss.VisibleEditorLines:=ActiveSrcEdit.EditorComponent.LinesInWindow;
{$IFDEF IDEDEBUG}
{$IFDEF IDE_DEBUG}
writeln('');
writeln('[TMainIDE.DoJumpToProcedureSection] ************');
{$ENDIF}
@ -3724,11 +3973,12 @@ begin
GetUnitWithPageIndex(SourceNoteBook.NoteBook.PageIndex,ActiveSrcEdit,
ActiveUnitInfo);
if (ActiveSrcEdit=nil) or (ActiveUnitInfo=nil) then exit;
FOpenEditorsOnCodeToolChange:=true;
SaveSourceEditorChangesToCodeCache;
CodeToolBoss.VisibleEditorLines:=ActiveSrcEdit.EditorComponent.LinesInWindow;
{$IFDEF IDEDEBUG}
{$IFDEF IDE_DEBUG}
writeln('');
writeln('[TMainIDE.DoJumpToProcedureSection] ************');
writeln('[TMainIDE.DoCompleteCodeAtCursor] ************');
{$ENDIF}
if CodeToolBoss.CompleteCode(ActiveUnitInfo.Source,
ActiveSrcEdit.EditorComponent.CaretX,
@ -3748,256 +3998,28 @@ writeln('[TMainIDE.DoJumpToProcedureSection] ************');
NewSrcEdit.EditorComponent.CaretXY:=Point(NewX,NewY);
NewSrcEdit.EditorComponent.TopLine:=NewTopLine;
end else begin
// probably a syntax error or just not in a procedure head/body / class
// -> ignore
// error: probably a syntax error or just not in a procedure head/body
// or not in a class
// -> there are enough events to handle everything, so it is ignored here
ApplyCodeToolChanges;
end;
FOpenEditorsOnCodeToolChange:=false;
end;
procedure TMainIDE.OnDesignerGetSelectedComponentClass(Sender: TObject;
var RegisteredComponent: TRegisteredComponent);
begin
RegisteredComponent:=SelectedComponent;
end;
procedure TMainIDE.OnDesignerUnselectComponentClass(Sender: TObject);
begin
ControlClick(ComponentNoteBook);
end;
procedure TMainIDE.OnDesignerSetDesigning(Sender: TObject;
Component: TComponent; Value: boolean);
begin
SetDesigning(Component,Value);
end;
procedure TMainIDE.OnDesignerComponentListChanged(Sender: TObject);
begin
ObjectInspector1.FillComponentComboBox;
end;
procedure TMainIDE.OnDesignerPropertiesChanged(Sender: TObject);
begin
ObjectInspector1.RefreshPropertyValues;
end;
procedure TMainIDE.OnDesignerAddComponent(Sender: TObject;
Component: TComponent; ComponentClass: TRegisteredComponent);
var i: integer;
ActiveForm: TCustomForm;
ActiveUnitInfo: TUnitInfo;
ActiveSrcEdit: TSourceEditor;
FormClassName: string;
begin
ActiveForm:=TDesigner(Sender).Form;
if ActiveForm=nil then begin
writeln('[TMainIDE.OnDesignerAddComponent] Error: TDesigner without a form');
halt;
end;
// find source for form
i:=Project.UnitCount-1;
while (i>=0) do begin
if (Project.Units[i].Loaded)
and (Project.Units[i].Form=ActiveForm) then break;
dec(i);
end;
if i<0 then begin
writeln('[TMainIDE.OnDesignerAddComponent] Error: form without source');
halt;
end;
ActiveUnitInfo:=Project.Units[i];
// add needed unit to source
CodeToolBoss.AddUnitToMainUsesSection(ActiveUnitInfo.Source,
ComponentClass.UnitName,'');
// add component definition to form source
FormClassName:=ActiveForm.ClassName;
if CodeToolBoss.PublishedVariableExists(ActiveUnitInfo.Source,'*',
FormClassName) then begin
CodeToolBoss.AddPublishedVariable(ActiveUnitInfo.Source,FormClassName,
Component.Name, Component.ClassName);
ActiveUnitInfo.Modified:=true;
ActiveSrcEdit:=SourceNoteBook.FindSourceEditorWithPageIndex(
ActiveUnitInfo.EditorIndex);
ActiveUnitInfo.Source.Assign(ActiveSrcEdit.Source);
ActiveSrcEdit.EditorComponent.Modified:=true;
end;
end;
procedure TMainIDE.OnDesignerRemoveComponent(Sender: TObject;
Component: TComponent);
var i: integer;
ActiveForm: TCustomForm;
ActiveUnitInfo: TUnitInfo;
ActiveSrcEdit: TSourceEditor;
FormClassName: string;
begin
ActiveForm:=TDesigner(Sender).Form;
if ActiveForm=nil then begin
writeln('[TMainIDE.OnDesignerAddComponent] Error: TDesigner without a form');
halt;
end;
// find source for form
i:=Project.UnitCount-1;
while (i>=0) do begin
if (Project.Units[i].Loaded)
and (Project.Units[i].Form=ActiveForm) then break;
dec(i);
end;
if i<0 then begin
writeln('[TMainIDE.OnDesignerAddComponent] Error: form without source');
halt;
end;
ActiveUnitInfo:=Project.Units[i];
// remove component definition to form source
FormClassName:=ActiveForm.ClassName;
if CodeToolBoss.RemovePublishedVariable(ActiveUnitInfo.Source,FormClassName,
Component.Name) then begin
ActiveUnitInfo.Modified:=true;
ActiveSrcEdit:=SourceNoteBook.FindSourceEditorWithPageIndex(
ActiveUnitInfo.EditorIndex);
ActiveUnitInfo.Source.Assign(ActiveSrcEdit.Source);
ActiveSrcEdit.EditorComponent.Modified:=true;
end;
end;
procedure TMainIDE.OnDesignerModified(Sender: TObject);
var i: integer;
begin
i:=Project.IndexOfUnitWithForm(TDesigner(Sender).Form,false);
if i>=0 then begin
Project.Units[i].Modified:=true;
if Project.Units[i].Loaded then
SourceNotebook.FindSourceEditorWithPageIndex(
Project.Units[i].EditorIndex).EditorComponent.Modified:=true;
end;
end;
procedure TMainIDE.OnControlSelectionChanged(Sender: TObject);
var NewSelectedComponents : TComponentSelectionList;
i: integer;
begin
writeln('[TMainIDE.OnControlSelectionChanged]');
if (TheControlSelection=nil) or (FormEditor1=nil) then exit;
NewSelectedComponents:=TComponentSelectionList.Create;
for i:=0 to TheControlSelection.Count-1 do begin
NewSelectedComponents.Add(TheControlSelection[i].Component);
end;
FormEditor1.SelectedComponents:=NewSelectedComponents;
NewSelectedComponents.Free;
writeln('[TMainIDE.OnControlSelectionChanged] END');
end;
procedure TMainIDE.InitCodeToolBoss;
var CompilerUnitSearchPath: string;
ADefTempl: TDefineTemplate;
c: integer;
begin
if (not FileExists(EnvironmentOptions.CompilerFilename)) then begin
writeln('');
writeln('Warning *: Compiler Filename not set! (see Environment Options)');
end;
if (EnvironmentOptions.LazarusDirectory='') then begin
writeln('');
writeln(
'Warning *: Lazarus Source Directory not set! (see Environment Options)');
end;
if (EnvironmentOptions.FPCSourceDirectory='') then begin
writeln('');
writeln(
'Warning: FPC Source Directory not set! (see Environment Options)');
end;
// set global variables
with CodeToolBoss.GlobalValues do begin
Variables[ExternalMacroStart+'LazarusSrcDir']:=
EnvironmentOptions.LazarusDirectory;
Variables[ExternalMacroStart+'FPCSrcDir']:=
EnvironmentOptions.FPCSourceDirectory;
Variables[ExternalMacroStart+'LCLWidgetType']:='gtk';
Variables[ExternalMacroStart+'ProjectDir']:='';
end;
// build DefinePool and Define Tree
with CodeToolBoss.DefinePool do begin
ADefTempl:=CreateFPCTemplate(EnvironmentOptions.CompilerFilename,
CompilerUnitSearchPath);
if ADefTempl=nil then begin
writeln('');
writeln(
'Warning: Could not create Define Template for Free Pascal Compiler');
end;
Add(ADefTempl);
CodeToolBoss.DefineTree.Add(ADefTempl.CreateCopy);
ADefTempl:=CreateFPCSrcTemplate(EnvironmentOptions.FPCSourceDirectory,
CompilerUnitSearchPath);
if ADefTempl=nil then begin
writeln('');
writeln(
'Warning: Could not create Define Template for Free Pascal Sources');
end;
Add(ADefTempl);
CodeToolBoss.DefineTree.Add(ADefTempl.CreateCopy);
ADefTempl:=CreateLazarusSrcTemplate('$(#LazarusSrcDir)','$(#LCLWidgetType)');
if ADefTempl=nil then begin
writeln('');
writeln(
'Warning: Could not create Define Template for Lazarus Sources');
end;
Add(ADefTempl);
CodeToolBoss.DefineTree.Add(ADefTempl.CreateCopy);
end;
// build define tree
with CodeToolBoss do begin
DefineTree.Add(DefinePool.CreateLCLProjectTemplate(
'$(#LazarusSrcDir)','$(#LCLWidgetType)','$(#ProjectDir)'));
//DefineTree.WriteDebugReport;
end;
c:=CodeToolBoss.ConsistencyCheck;
if c<>0 then begin
writeln('CodeToolBoss.ConsistencyCheck=',c);
Halt;
end;
with CodeToolBoss do begin
OnBeforeApplyChanges:=@OnBeforeCodeToolBossApplyChanges;
WriteExceptions:=true;
CatchExceptions:=true;
end;
end;
procedure TMainIDE.OnBeforeCodeToolBossApplyChanges(Manager: TCodeToolManager;
var Abort: boolean);
// the CodeToolBoss built a list of Sources that will be modified
// -> open all of them in the source editor
var i: integer;
begin
for i:=0 to Manager.SourceChangeCache.BuffersToModifyCount-1 do begin
if DoOpenEditorFile(Manager.SourceChangeCache.BuffersToModify[i].Filename,
false)<>mrOk then
begin
Abort:=true;
exit;
end;
end;
end;
initialization
{ $I mainide.lrs}
{$I images/laz_images.lrs}
{$I images/mainicon.lrs}
end.
{ =============================================================================
$Log$
Revision 1.119 2001/10/12 23:23:17 lazarus
MG: added new key: complete code
Revision 1.120 2001/10/15 13:11:27 lazarus
MG: added complete code
Revision 1.115 2001/10/09 09:46:49 lazarus
MG: added codetools, fixed synedit unindent, fixed MCatureHandle

4
ide/project.pp
View File

@ -1469,8 +1469,8 @@ end.
{
$Log$
Revision 1.29 2001/10/12 17:34:24 lazarus
MG: added code completion
Revision 1.30 2001/10/15 13:11:27 lazarus
MG: added complete code
Revision 1.27 2001/10/09 09:46:50 lazarus
MG: added codetools, fixed synedit unindent, fixed MCatureHandle

299
ide/uniteditor.pp
View File

@ -36,10 +36,9 @@ uses
{$ENDIF}
Classes, Controls, Forms, Buttons, ComCtrls, SysUtils, Dialogs, FormEditor,
FindReplaceDialog, EditorOptions, CustomFormEditor, KeyMapping, StdCtrls,
Compiler, MsgView, WordCompletion, CodeToolManager, CodeCache,
Compiler, MsgView, WordCompletion, CodeToolManager, CodeCache, SourceLog,
SynEdit, SynEditHighlighter, SynHighlighterPas, SynEditAutoComplete,
SynEditKeyCmds,SynCompletion,
Graphics, Extctrls, Menus;
SynEditKeyCmds,SynCompletion, Graphics, Extctrls, Menus;
type
// --------------------------------------------------------------------------
@ -72,13 +71,15 @@ type
//if this is a Form or Datamodule, this is used
FControl: TComponent;
FFileName : AnsiString;
FCodeBuffer: TCodeBuffer;
FIgnoreCodeBufferLock: integer;
FShortName : String;
FPopUpMenu : TPopupMenu;
FSyntaxHighlighterType: TLazSyntaxHighlighter;
FErrorLine: integer;
FExecutionLine: integer;
FModified: boolean;
FOnAfterClose : TNotifyEvent;
FOnAfterOpen : TNotifyEvent;
@ -93,6 +94,7 @@ type
Function FindFile(const Value : String) : String;
procedure SetCodeBuffer(NewCodeBuffer: TCodeBuffer);
Function GetSource : TStrings;
Procedure SetSource(Value : TStrings);
Function GetCurrentCursorXLine : Integer;
@ -109,6 +111,7 @@ type
procedure SetCodeTemplates(
NewCodeTemplates: TSynEditAutoComplete);
procedure SetPopupMenu(NewPopupMenu: TPopupMenu);
function GetFilename: string;
Function GotoLine(Value : Integer) : Integer;
@ -141,6 +144,8 @@ type
ASyntaxHighlighterType: TLazSyntaxHighlighter);
procedure SetErrorLine(NewLine: integer);
procedure SetExecutionLine(NewLine: integer);
procedure OnCodeBufferChanged(Sender: TSourceLog;
SrcLogEntry: TSourceLogEntry);
property Visible : Boolean read FVisible write FVisible default False;
public
@ -149,14 +154,18 @@ type
Procedure SelectText(LineNum,CharStart,LineNum2,CharEnd : Integer);
Function Close : Boolean;
procedure AdjustMarksByCodeCache;
procedure IncreaseIgnoreCodeBufferLock;
procedure DecreaseIgnoreCodeBufferLock;
procedure UpdateCodeBuffer; // copy the source from EditorComponent
procedure StartFindAndReplace(Replace:boolean);
procedure OnReplace(Sender: TObject; const ASearch, AReplace:
string; Line, Column: integer; var Action: TSynReplaceAction);
procedure DoFindAndReplace;
procedure FindAgain;
procedure GetDialogPosition(Width, Height:integer; var Left,Top:integer);
property CodeBuffer: TCodeBuffer read FCodeBuffer write SetCodeBuffer;
property Control : TComponent read FControl write FControl;
property CurrentCursorXLine : Integer
read GetCurrentCursorXLine write SetCurrentCursorXLine;
@ -165,7 +174,7 @@ type
property Owner : TComponent read FAOwner;
property Source : TStrings read GetSource write SetSource;
property ShortName : String read FShortName write fShortName;
property FileName : AnsiString read FFileName write FFilename;
property FileName : AnsiString read GetFileName;
property Modified : Boolean read GetModified write SetModified;
property ReadOnly : Boolean read GetReadOnly;
property InsertMode : Boolean read GetInsertmode;
@ -263,6 +272,8 @@ type
function EditorCount:integer;
function FindSourceEditorWithPageIndex(PageIndex:integer):TSourceEditor;
Function GetActiveSE : TSourceEditor;
procedure LockAllEditorsInSourceChangeCache;
procedure UnlockAllEditorsInSourceChangeCache;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -797,16 +808,20 @@ end;
Procedure TSourceEditor.UserCommandProcessed(Sender: TObject;
var Command: TSynEditorCommand; var AChar: char; Data: pointer);
//Handled: boolean;
var Handled: boolean;
begin
{Handled:=true;
Handled:=true;
case Command of
else begin
Handled:=false;}
TSourceNotebook(FaOwner).ParentCommandProcessed(self,Command,aChar,Data);
{end;
if Handled then Command:=ecNone;}
ecUndo:
if (FEditor.Modified=false) and (CodeBuffer<>nil) then
CodeBuffer.Assign(FEditor.Lines);
else
begin
Handled:=false;
TSourceNotebook(FaOwner).ParentCommandProcessed(self,Command,aChar,Data);
end;
end;
if Handled then Command:=ecNone;
end;
Procedure TSourceEditor.EditorStatusChanged(Sender: TObject;
@ -839,7 +854,7 @@ begin
if Assigned(FOnDeleteBreakPoint) then FOnDeleteBreakPoint(Self,Line);
fEditor.Marks.Remove(BreakPtMark);
BreakPtMark.Free;
fEditor.Modified:=true;
fModified:=true;
end else begin
// create breakpoint
BreakPtMark:=TSynEditMark.Create(fEditor);
@ -850,7 +865,7 @@ begin
BreakPtMark.Line:=Line;
fEditor.Marks.Place(BreakPtMark);
if Assigned(FOnCreateBreakPoint) then FOnCreateBreakPoint(Self,Line);
fEditor.Modified:=true;
fModified:=true;
end;
end;
@ -1121,6 +1136,144 @@ TControl(FCOntrol).Visible := False;
TControl(FCOntrol).Visible := True;
end;
procedure TSourceEditor.SetCodeBuffer(NewCodeBuffer: TCodeBuffer);
begin
if NewCodeBuffer=FCodeBuffer then exit;
if FCodeBuffer<>nil then
FCodeBuffer.RemoveChangeHook(@OnCodeBufferChanged);
FCodeBuffer:=NewCodeBuffer;
if FCodeBuffer<>nil then begin
FCodeBuffer.AddChangeHook(@OnCodeBufferChanged);
if (FIgnoreCodeBufferLock<=0) and (not FCodeBuffer.IsEqual(FEditor.Lines))
then begin
{$IFDEF IDE_DEBUG}
writeln('');
writeln('WARNING: TSourceEditor.SetCodeBuffer - loosing marks');
writeln('');
{$ENDIF}
FCodeBuffer.AssignTo(FEditor.Lines);
end;
end;
end;
procedure TSourceEditor.OnCodeBufferChanged(Sender: TSourceLog;
SrcLogEntry: TSourceLogEntry);
procedure InsertTxt(StartPos: TPoint; const Txt: string);
begin
FEditor.CaretXY:=StartPos;
FEditor.BlockBegin:=StartPos;
FEditor.BlockEnd:=StartPos;
FEditor.SelText:=Txt;
end;
procedure DeleteTxt(StartPos, EndPos: TPoint);
begin
FEditor.CaretXY:=StartPos;
FEditor.BlockBegin:=StartPos;
FEditor.BlockEnd:=EndPos;
FEditor.SelText:='';
end;
procedure MoveTxt(StartPos, EndPos, MoveToPos: TPoint;
DirectionForward: boolean);
var Txt: string;
begin
FEditor.CaretXY:=StartPos;
FEditor.BlockBegin:=StartPos;
FEditor.BlockEnd:=EndPos;
Txt:=FEditor.SelText;
if DirectionForward then begin
FEditor.CaretXY:=MoveToPos;
FEditor.BlockBegin:=MoveToPos;
FEditor.BlockEnd:=MoveToPos;
FEditor.SelText:=Txt;
FEditor.CaretXY:=StartPos;
FEditor.BlockBegin:=StartPos;
FEditor.BlockEnd:=EndPos;
FEditor.SelText:='';
end else begin
FEditor.SelText:='';
FEditor.CaretXY:=MoveToPos;
FEditor.BlockBegin:=MoveToPos;
FEditor.BlockEnd:=MoveToPos;
FEditor.SelText:=Txt;
end;
end;
var StartPos, EndPos, MoveToPos: TPoint;
begin
{$IFDEF IDE_DEBUG}
writeln('[TSourceEditor.OnCodeBufferChanged] A ',FIgnoreCodeBufferLock,' ',SrcLogEntry<>nil);
{$ENDIF}
if FIgnoreCodeBufferLock>0 then exit;
if SrcLogEntry<>nil then begin
FEditor.BeginUpdate;
FEditor.BeginUndoBlock;
case SrcLogEntry.Operation of
sleoInsert:
begin
Sender.AbsoluteToLineCol(SrcLogEntry.Position,StartPos.Y,StartPos.X);
if StartPos.Y>=1 then
InsertTxt(StartPos,SrcLogEntry.Txt);
end;
sleoDelete:
begin
Sender.AbsoluteToLineCol(SrcLogEntry.Position,StartPos.Y,StartPos.X);
Sender.AbsoluteToLineCol(SrcLogEntry.Position+SrcLogEntry.Len,
EndPos.Y,EndPos.X);
if (StartPos.Y>=1) and (EndPos.Y>=1) then
DeleteTxt(StartPos,EndPos);
end;
sleoMove:
begin
Sender.AbsoluteToLineCol(SrcLogEntry.Position,StartPos.Y,StartPos.X);
Sender.AbsoluteToLineCol(SrcLogEntry.Position+SrcLogEntry.Len,
EndPos.Y,EndPos.X);
Sender.AbsoluteToLineCol(SrcLogEntry.MoveTo,MoveToPos.Y,MoveToPos.X);
if (StartPos.Y>=1) and (EndPos.Y>=1) and (MoveToPos.Y>=1) then
MoveTxt(StartPos, EndPos, MoveToPos,
SrcLogEntry.Position<SrcLogEntry.MoveTo);
end;
end;
FEditor.EndUndoBlock;
FEditor.EndUpdate;
end else begin
if Sender.IsEqual(FEditor.Lines) then exit;
Sender.AssignTo(FEditor.Lines);
end;
end;
procedure TSourceEditor.IncreaseIgnoreCodeBufferLock;
begin
inc(FIgnoreCodeBufferLock);
end;
procedure TSourceEditor.DecreaseIgnoreCodeBufferLock;
begin
if FIgnoreCodeBufferLock<=0 then exit;
dec(FIgnoreCodeBufferLock);
end;
procedure TSourceEditor.UpdateCodeBuffer;
// copy the source from EditorComponent
begin
if not FEditor.Modified then exit;
{$IFDEF IDE_DEBUG}
if FCodeBuffer=nil then begin
writeln('');
writeln('*********** Oh, no: UpdateCodeBuffer ************');
writeln('');
end;
{$ENDIF}
if FCodeBuffer=nil then exit;
IncreaseIgnoreCodeBufferLock;
FModified:=FModified or FEditor.Modified;
FCodeBuffer.Assign(FEditor.Lines);
FEditor.Modified:=false;
DecreaseIgnoreCodeBufferLock;
end;
Function TSourceEditor.GetSource : TStrings;
Begin
//return synedit's source.
@ -1166,12 +1319,13 @@ end;
Function TSourceEditor.GetModified : Boolean;
Begin
Result := FEditor.Modified;
Result := FEditor.Modified or FModified;
end;
procedure TSourceEditor.SetModified(NewValue:boolean);
begin
FEditor.Modified:=NewValue;
FModified:=NewValue;
if not FModified then FEditor.Modified:=false;
end;
Function TSourceEditor.GetInsertMode : Boolean;
@ -1186,6 +1340,7 @@ Begin
FOnBeforeClose(Self);
Visible := False;
CodeBuffer := nil;
If Assigned(FOnAfterClose) then FOnAfterClose(Self);
end;
@ -1211,7 +1366,6 @@ begin
end;
dec(i);
end;
end;
Procedure TSourceEditor.ReParent(AParent : TWInControl);
@ -1238,6 +1392,14 @@ begin
end;
end;
function TSourceEditor.GetFilename: string;
begin
if FCodeBuffer<>nil then
Result:=FCodeBuffer.Filename
else
Result:='';
end;
{------------------------------------------------------------------------}
{ TSourceNotebook }
@ -1746,15 +1908,39 @@ End;
Function TSourceNotebook.CreateNotebook : Boolean;
Begin
{$IFDEF IDE_DEBUG}
writeln('[TSourceNotebook.CreateNotebook] START');
{$ENDIF}
{$IFDEF IDE_MEM_CHECK}
CheckHeap('[TSourceNotebook.CreateNotebook] A '+IntToStr(GetMem_Cnt));
{$ENDIF}
ClearUnUsedEditorComponents(false);
{$IFDEF IDE_DEBUG}
writeln('[TSourceNotebook.CreateNotebook] A');
{$ENDIF}
{$IFDEF IDE_MEM_CHECK}
CheckHeap('[TSourceNotebook.CreateNotebook] B '+IntToStr(GetMem_Cnt));
{$ENDIF}
Result := False;
if not assigned(Notebook) then
Begin
Result := True;
{$IFDEF IDE_DEBUG}
writeln('[TSourceNotebook.CreateNotebook] B');
{$ENDIF}
Notebook := TNotebook.Create(self);
{$IFDEF IDE_DEBUG}
writeln('[TSourceNotebook.CreateNotebook] C');
{$ENDIF}
{$IFDEF IDE_MEM_CHECK}
CheckHeap('[TSourceNotebook.CreateNotebook] C '+IntToStr(GetMem_Cnt));
{$ENDIF}
with Notebook do
Begin
Parent := Self;
{$IFDEF IDE_DEBUG}
writeln('[TSourceNotebook.CreateNotebook] D');
{$ENDIF}
Align := alClient;
Left := 0;
Top :=2;
@ -1763,11 +1949,25 @@ Begin
Pages.Strings[0] := 'unit1';
PageIndex := 0; // Set it to the first page
OnPageChanged := @NotebookPageChanged;
Show;
{$IFDEF IDE_DEBUG}
writeln('[TSourceNotebook.CreateNotebook] E');
{$ENDIF}
Visible := true;
{$IFDEF IDE_DEBUG}
writeln('[TSourceNotebook.CreateNotebook] F');
{$ENDIF}
{$IFDEF IDE_MEM_CHECK}
CheckHeap('[TSourceNotebook.CreateNotebook] F '+IntToStr(GetMem_Cnt));
{$ENDIF}
end; //with
Show; //used to display the code form
end;
{$IFDEF IDE_DEBUG}
writeln('[TSourceNotebook.CreateNotebook] END');
{$ENDIF}
{$IFDEF IDE_MEM_CHECK}
CheckHeap('[TSourceNotebook.CreateNotebook] END '+IntToStr(GetMem_Cnt));
{$ENDIF}
End;
Procedure TSourceNotebook.ClearUnUsedEditorComponents(Force: boolean);
@ -2029,6 +2229,36 @@ Begin
Result:= FindSourceEditorWithPageIndex(Notebook.PageIndex);
end;
procedure TSourceNotebook.LockAllEditorsInSourceChangeCache;
// lock all sourceeditors that are to be modified by the CodeToolBoss
var i: integer;
begin
for i:=0 to EditorCount-1 do begin
if CodeToolBoss.SourceChangeCache.BufferIsModified(Editors[i].CodeBuffer)
then begin
with Editors[i].EditorComponent do begin
BeginUpdate;
BeginUndoBlock;
end;
end;
end;
end;
procedure TSourceNotebook.UnlockAllEditorsInSourceChangeCache;
// lock all sourceeditors that are to be modified by the CodeToolBoss
var i: integer;
begin
for i:=0 to EditorCount-1 do begin
if CodeToolBoss.SourceChangeCache.BufferIsModified(Editors[i].CodeBuffer)
then begin
with Editors[i].EditorComponent do begin
EndUndoBlock;
EndUpdate;
end;
end;
end;
end;
Function TSourceNotebook.Empty : Boolean;
Begin
Result := (not assigned(Notebook)) or (Notebook.Pages.Count = 0);
@ -2190,22 +2420,28 @@ Var
TempEditor : TSourceEditor;
Begin
//create a new page
//writeln('[TSourceNotebook.NewFile] A ');
{$IFDEF IDE_DEBUG}
writeln('[TSourceNotebook.NewFile] A ');
{$ENDIF}
TempEditor := NewSE(-1);
//writeln('[TSourceNotebook.NewFile] B ');
writeln('[TSourceNotebook.NewFile] B ');
TempEditor.ShortName := NewShortName;
//writeln('[TSourceNotebook.NewFile] C ');
ASource.AssignTo(TempEditor.Source);
//writeln('[TSourceNotebook.NewFile] D ');
writeln('[TSourceNotebook.NewFile] C ');
TempEditor.CodeBuffer:=ASource;
writeln('[TSourceNotebook.NewFile] D ');
Notebook.Pages[Notebook.PageIndex] :=
FindUniquePageName(NewShortName,Notebook.PageIndex);
//writeln('[TSourceNotebook.NewFile] end');
{$IFDEF IDE_DEBUG}
writeln('[TSourceNotebook.NewFile] end');
{$ENDIF}
end;
Procedure TSourceNotebook.CloseFile(PageIndex:integer);
var TempEditor: TSourceEditor;
Begin
//writeln('TSourceNotebook.CloseFile A PageIndex=',PageIndex);
{$IFDEF IDE_DEBUG}
writeln('TSourceNotebook.CloseFile A PageIndex=',PageIndex);
{$ENDIF}
TempEditor:= FindSourceEditorWithPageIndex(PageIndex);
if TempEditor=nil then exit;
TempEditor.Close;
@ -2223,7 +2459,9 @@ Begin
Notebook:=nil;
Hide;
end;
//writeln('TSourceNotebook.CloseFile END');
{$IFDEF IDE_DEBUG}
writeln('TSourceNotebook.CloseFile END');
{$ENDIF}
end;
Procedure TSourceNotebook.NewClicked(Sender: TObject);
@ -2383,7 +2621,8 @@ begin
Format(' %6d:%4d',[TempEditor.CurrentCursorYLine,TempEditor.CurrentCursorXLine]);
if GetActiveSE.InsertMode then
Statusbar.Panels[2].Text := 'INS' else
Statusbar.Panels[2].Text := 'INS'
else
Statusbar.Panels[2].Text := 'OVR';
End;

10
lcl/include/application.inc
View File

@ -288,12 +288,9 @@ begin
raise;
end;
if FMainForm = nil then
begin
if FMainForm = nil then begin
FMainForm := TForm(ref);
end
else
begin;
end else begin
if not assigned(FList) then
FList := TList.Create;
FList.Add(TForm(ref));
@ -303,6 +300,9 @@ end;
{ =============================================================================
$Log$
Revision 1.8 2001/10/15 13:11:28 lazarus
MG: added complete code
Revision 1.7 2001/07/01 23:33:13 lazarus
MG: added WaitMessage and HandleEvents is now non blocking