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 code completion

Browse Source 
git-svn-id: trunk@347 -
This commit is contained in:
lazarus 2001-10-12 17:34:27 +00:00
parent a8ba6a499f
commit e4f88ae491
8 changed files with 380 additions and 145 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
components/codetools/basiccodetools.pas
View File

@ -1606,7 +1606,8 @@ end;
function GetIndentStr(Indent: integer): string;
begin
SetLength(Result,Indent);
FillChar(Result[1],length(Result),' ');
if Indent>0 then
FillChar(Result[1],length(Result),' ');
end;
//=============================================================================

12
components/codetools/codecache.pas
View File

@ -125,6 +125,7 @@ type
property ExpirationTimeInDays: integer
read FExpirationTimeInDays write FExpirationTimeInDays;
procedure Clear;
procedure ClearAllSourleLogEntries;
constructor Create;
destructor Destroy; override;
procedure OnBufferSetScanner(Sender: TCodeBuffer);
@ -172,6 +173,17 @@ begin
FItems.FreeAndClear;
end;
procedure TCodeCache.ClearAllSourleLogEntries;
var
ANode: TAVLTreeNode;
begin
ANode:=FItems.FindLowest;
while ANode<>nil do begin
TCodeBuffer(ANode.Data).ClearEntries;
ANode:=FItems.FindSuccessor(ANode);
end;
end;
function TCodeCache.Count: integer;
begin
Result:=FItems.Count;

306
components/codetools/codetools.pas
View File

@ -1436,8 +1436,9 @@ begin
and (ANode.StartPos>=1) then begin
ASrcLen:=length(ASource);
NodeSrcLen:=ANode.EndPos-ANode.StartPos;
if ASrcLen=NodeSrcLen then begin
for i:=1 to ASrcLen do
if ASrcLen<=NodeSrcLen then begin
i:=1;
while (i<=ASrcLen) and (IsIdentChar[Src[ANode.StartPos-1+i]]) do begin
if ASource[i]<>UpperSrc[ANode.StartPos-1+i] then begin
if ASource[i]>UpperSrc[ANode.StartPos-1+i] then
Result:=1
@ -1445,10 +1446,10 @@ begin
Result:=-1;
exit;
end;
inc(i);
end;
Result:=0;
end else if ASrcLen<NodeSrcLen then
Result:=1
else
end else
Result:=-1;
end else
Result:=-1;
@ -4023,17 +4024,18 @@ begin
else
ExtractMemStream.Write(Src[LastAtomEndPos],
CurPos.StartPos-LastAtomEndPos)
end else if CurPos.StartPos>LastAtomEndPos then begin
end else if (CurPos.StartPos>LastAtomEndPos)
and (ExtractMemStream.Position>0) then begin
ExtractMemStream.Write(' ',1);
end;
if AddAtom then begin
if phpInUpperCase in Attr then
ExtractMemStream.Write(UpperSrc[CurPos.StartPos],
CurPos.EndPos-CurPos.StartPos)
else
ExtractMemStream.Write(Src[CurPos.StartPos],
CurPos.EndPos-CurPos.StartPos);
end;
end;
if AddAtom then begin
if phpInUpperCase in Attr then
ExtractMemStream.Write(UpperSrc[CurPos.StartPos],
CurPos.EndPos-CurPos.StartPos)
else
ExtractMemStream.Write(Src[CurPos.StartPos],
CurPos.EndPos-CurPos.StartPos);
end;
if (ExtractSearchPos>0)
and (ExtractSearchPos<=ExtractMemStream.Position)
@ -4108,6 +4110,7 @@ begin
s:=TheClassName+'.';
if not (phpWithoutName in Attr) then
s:=s+GetAtom;
if phpInUpperCase in Attr then s:=UpperCaseStr(s);
ExtractNextAtom(false,Attr);
ExtractMemStream.Write(s[1],length(s));
end;
@ -5575,6 +5578,7 @@ begin
if cmp then begin
//writeln('[TMethodJumpingCodeTool.GatherProcNodes] C');
CurProcName:=ExtractProcHead(ANode,Attr);
//writeln('[TMethodJumpingCodeTool.GatherProcNodes] D "',CurProcName,'" ',phpInUpperCase in Attr);
if (CurProcName<>'') then begin
NewNodeExt:=TCodeTreeNodeExtension.Create;
with NewNodeExt do begin
@ -6249,9 +6253,10 @@ function TCodeCompletionCodeTool.ProcExists(
const NameAndParams: string): boolean;
// NameAndParams should be uppercase and contains the proc name and the
// parameter list without names and default values
// and should not contain any comments
// and should not contain any comments, result types
var ANodeExt: TCodeTreeNodeExtension;
begin
Result:=false;
// search in new nodes, which will be inserted
ANodeExt:=FirstInsert;
while ANodeExt<>nil do begin
@ -6271,6 +6276,7 @@ end;
function TCodeCompletionCodeTool.VarExists(const UpperName: string): boolean;
var ANodeExt: TCodeTreeNodeExtension;
begin
Result:=false;
// search in new nodes, which will be inserted
ANodeExt:=FirstInsert;
while ANodeExt<>nil do begin
@ -6320,16 +6326,20 @@ begin
end;
if (InsertPos=nil)
or (CompareTextIgnoringSpace(InsertPos.Txt,CleanDef,true)>0) then begin
// insert after last
NewInsert.Next:=Last.Next;
Last.Next:=NewInsert;
if Last<>nil then begin
// insert after last
NewInsert.Next:=Last.Next;
Last.Next:=NewInsert;
end else begin
NewInsert.Next:=InsertPos;
FirstInsert:=NewInsert;
end;
end else begin
// insert after InsertPos
NewInsert.Next:=InsertPos.Next;
InsertPos.Next:=NewInsert;
end;
end;
FirstInsert:=NewInsert;
end;
function TCodeCompletionCodeTool.NodeExtIsVariable(
@ -6358,7 +6368,7 @@ function TCodeCompletionCodeTool.CompleteProperty(
property Col8: ICol8 read FCol8 write FCol8 implements ICol8;
property specifiers without parameters:
nodefault
;nodefault, ;default
property specifiers with parameters:
index <constant>, read <id>, write <id>, implements <id>,
@ -6415,8 +6425,6 @@ begin
Result:=true;
exit;
end;
ReadNextAtom; // read ':'
if not AtomIsChar(':') then exit;
ReadNextAtom; // read type
if (CurPos.StartPos>PropNode.EndPos)
or UpAtomIs('END') or AtomIsChar(';') then exit;
@ -6468,31 +6476,33 @@ begin
ASourceChangeCache.BeautifyCodeOptions.PropertyReadIdentPrefix;
if Parts[ppRead].StartPos>0 then
AccessParam:=copy(Src,Parts[ppRead].StartPos,
Parts[ppRead].EndPos-Parts[ppRead].StartPos)
Parts[ppRead].EndPos-Parts[ppRead].StartPos)
else
AccessParam:=AccessParamPrefix+copy(Src,Parts[ppName].StartPos,
Parts[ppName].EndPos-Parts[ppName].StartPos);
AccessParam:='';
if (Parts[ppParamList].StartPos>0) or (Parts[ppIndexWord].StartPos>0)
or (AnsiCompareText(AccessParamPrefix,
LeftStr(AccessParam,length(AccessParamPrefix)))=0) then
begin
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
CleanAccessFunc:=UpperCaseStr(AccessParam)+'('+CleanParamList+')';
CleanAccessFunc:=UpperCaseStr(AccessParam)+'('+CleanParamList+');';
end else begin
// index + param list
CleanAccessFunc:=UpperCaseStr(AccessParam)+'(:INTEGER;'
+CleanParamList+')';
+CleanParamList+');';
end;
end else begin
if (Parts[ppIndexWord].StartPos<1) then begin
// no param list, no index
CleanAccessFunc:=UpperCaseStr(AccessParam);
CleanAccessFunc:=UpperCaseStr(AccessParam)+';';
end else begin
// index, no param list
CleanAccessFunc:=UpperCaseStr(AccessParam)+'(:INTEGER)';
CleanAccessFunc:=UpperCaseStr(AccessParam)+'(:INTEGER);';
end;
end;
// check if function exists
@ -6531,6 +6541,10 @@ begin
AddInsert(PropNode,CleanAccessFunc,AccessFunc,AccessParam);
end;
end else begin
if Parts[ppRead].StartPos<1 then
AccessParam:=ASourceChangeCache.BeautifyCodeOptions.PrivatVariablePrefix
+copy(Src,Parts[ppName].StartPos,
Parts[ppName].EndPos-Parts[ppName].StartPos);
// the read identifier is a variable
if not VarExists(UpperCaseStr(AccessParam)) then begin
// variable does not exist yet -> add insert demand for variable
@ -6579,21 +6593,21 @@ begin
if (Parts[ppIndexWord].StartPos<1) then begin
// param list, no index
CleanAccessFunc:=UpperCaseStr(AccessParam)+'('+CleanParamList+';'
+'CONST AVALUE:'+PropType+')';
+' :'+UpperCaseStr(PropType)+');';
end else begin
// index + param list
CleanAccessFunc:=UpperCaseStr(AccessParam)+'(:INTEGER;'
+CleanParamList+';CONST AVALUE:'+PropType+')';
+CleanParamList+'; :'+UpperCaseStr(PropType)+');';
end;
end else begin
if (Parts[ppIndexWord].StartPos<1) then begin
// no param list, no index
CleanAccessFunc:=UpperCaseStr(AccessParam)
+'(CONST AVALUE:'+PropType+')';
+'( :'+UpperCaseStr(PropType)+');';
end else begin
// index, no param list
CleanAccessFunc:=UpperCaseStr(AccessParam)+'(:INTEGER;'
+'CONST AVALUE:'+PropType+')';
+' :'+UpperCaseStr(PropType)+');';
end;
end;
// check if procedure exists
@ -6692,7 +6706,7 @@ begin
AccessParam);
end;
end;
Result:=false;
Result:=true;
end;
procedure TCodeCompletionCodeTool.InsertNewClassParts(PartType: NewClassPart);
@ -6703,7 +6717,7 @@ var ANodeExt: TCodeTreeNodeExtension;
begin
ANodeExt:=FirstInsert;
while ANodeExt<>nil do begin
if NodeExtIsVariable(ANodeExt) and (PartType=ncpVars) then begin
if ((PartType=ncpVars)=NodeExtIsVariable(ANodeExt)) then begin
// search a privat section in front of the node
PrivatNode:=ANodeExt.Node.Parent.PriorBrother;
while (PrivatNode<>nil) and (PrivatNode.Desc<>ctnClassPrivate) do
@ -6712,6 +6726,8 @@ begin
// there is no privat section node in front of the property
if NewPrivatSectionInsertPos<1 then begin
// -> insert one at the end of the first published node
// Note: the first node is a fake published section, so the first
// real section is the second
ANode:=ClassNode.FirstChild.NextBrother;
if ANode=nil then ANode:=ClassNode;
NewPrivatSectionIndent:=GetLineIndent(Src,ANode.StartPos);
@ -6776,25 +6792,23 @@ begin
end
end;
if InsertNode<>nil then begin
// insert as first variable
if PrivatNode.FirstChild<>nil then begin
Indent:=GetLineIndent(Src,ANode.StartPos);
InsertPos:=ANode.StartPos;
end else begin
Indent:=GetLineIndent(Src,PrivatNode.StartPos)
+ASourceChangeCache.BeautifyCodeOptions.Indent;
InsertPos:=FindFirstLineEndAfterInCode(Src,PrivatNode.EndPos,
Scanner.NestedComments);
end;
end else begin
// insert in front of InsertNode
// insert after InsertNode
Indent:=GetLineIndent(Src,InsertNode.StartPos);
InsertPos:=FindFirstLineEndInFrontOfInCode(Src,ANode.StartPos,
InsertPos:=FindFirstLineEndAfterInCode(Src,InsertNode.EndPos,
Scanner.NestedComments);
end else begin
// insert as first variable
Indent:=GetLineIndent(Src,PrivatNode.StartPos)
+ASourceChangeCache.BeautifyCodeOptions.Indent;
InsertPos:=FindFirstLineEndAfterInCode(Src,PrivatNode.StartPos,
Scanner.NestedComments);
end;
end;
CurCode:=ANodeExt.ExtTxt1;
CurCode:=ASourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
CurCode,0);
ASourceChangeCache.Replace(gtNewLine,gtNewLine,InsertPos,InsertPos,
GetIndentStr(Indent)+ANodeExt.ExtTxt1);
GetIndentStr(Indent)+CurCode);
end;
ANodeExt:=ANodeExt.Next;
end;
@ -6842,30 +6856,42 @@ var
ANode, TypeSectionNode: TCodeTreeNode;
ClassStartComment, ProcCode: string;
begin
{$IFDEF CTDEBUG}
writeln('TCodeCompletionCodeTool.CreateMissingProcBodies Gather existing method bodies ... ');
{$ENDIF}
// gather existing class proc bodies
TypeSectionNode:=ClassNode.Parent;
if (TypeSectionNode<>nil) and (TypeSectionNode.Parent<>nil)
and (TypeSectionNode.Parent.Desc=ctnTypeSection) then
TypeSectionNode:=TypeSectionNode.Parent;
ClassProcs:=nil;
ProcBodyNodes:=GatherProcNodes(TypeSectionNode,
[phpInUpperCase,phpIgnoreForwards,phpOnlyWithClassname],
ExtractClassName(ClassNode,true));
ExistingNode:=ProcBodyNodes.FindLowest;
LastExistingProcBody:=TCodeTreeNodeExtension(ExistingNode.Data).Node;
FirstExistingProcBody:=LastExistingProcBody;
while ExistingNode<>nil do begin
ANode:=TCodeTreeNodeExtension(ExistingNode.Data).Node;
if ANode.StartPos<FirstExistingProcBody.StartPos then
FirstExistingProcBody:=ANode;
if ANode.StartPos>LastExistingProcBody.StartPos then
LastExistingProcBody:=ANode;
ExistingNode:=ProcBodyNodes.FindSuccessor(ExistingNode);
end;
// gather existing class proc definitions
ClassProcs:=GatherProcNodes(StartNode,[phpInUpperCase,phpAddClassname],
ExtractClassName(ClassNode,true));
try
ExistingNode:=ProcBodyNodes.FindLowest;
if ExistingNode<>nil then
LastExistingProcBody:=TCodeTreeNodeExtension(ExistingNode.Data).Node
else
LastExistingProcBody:=nil;
FirstExistingProcBody:=LastExistingProcBody;
while ExistingNode<>nil do begin
ANode:=TCodeTreeNodeExtension(ExistingNode.Data).Node;
if ANode.StartPos<FirstExistingProcBody.StartPos then
FirstExistingProcBody:=ANode;
if ANode.StartPos>LastExistingProcBody.StartPos then
LastExistingProcBody:=ANode;
ExistingNode:=ProcBodyNodes.FindSuccessor(ExistingNode);
end;
{$IFDEF CTDEBUG}
writeln('TCodeCompletionCodeTool.CreateMissingProcBodies Gather existing method declarations ... ');
{$ENDIF}
TheClassName:=ExtractClassName(ClassNode,false);
// gather existing class proc definitions
ClassProcs:=GatherProcNodes(StartNode,[phpInUpperCase,phpAddClassName],
ExtractClassName(ClassNode,true));
// add new class parts to ClassProcs
CurNode:=FirstExistingProcBody;
ANodeExt:=FirstInsert;
@ -6874,7 +6900,8 @@ begin
if FindNodeInTree(ClassProcs,ANodeExt.Txt)=nil then begin
NewNodeExt:=TCodeTreeNodeExtension.Create;
with NewNodeExt do begin
Txt:=ANodeExt.Txt; // Name+ParamTypeList
Txt:=UpperCaseStr(TheClassName)+'.'
+ANodeExt.Txt; // Name+ParamTypeList
ExtTxt1:=ANodeExt.ExtTxt1; // complete proc head code
end;
ClassProcs.Add(NewNodeExt);
@ -6883,11 +6910,10 @@ begin
ANodeExt:=ANodeExt.Next;
end;
TheClassName:=ExtractClassName(ClassNode,false);
// search for missing proc bodies
ExistingNode:=ProcBodyNodes.FindLowest;
MissingNode:=ClassProcs.FindLowest;
ExistingNode:=ProcBodyNodes.FindHighest;
MissingNode:=ClassProcs.FindHighest;
if ExistingNode=nil then begin
// there were no old proc bodies of the class
if NodeHasParentOfType(ClassNode,ctnInterface) then begin
@ -6906,8 +6932,7 @@ begin
if ANode.Parent.Desc=ctnTypeSection then
ANode:=ANode.Parent; // type section
if ANode=nil then exit;
Indent:=GetLineIndent(Src,ANode.StartPos)
+ASourceChangeCache.BeautifyCodeOptions.Indent;
Indent:=GetLineIndent(Src,ANode.StartPos);
InsertPos:=ANode.EndPos;
end;
// insert class comment
@ -6917,81 +6942,98 @@ begin
ClassStartComment);
// insert all missing proc bodies
while (MissingNode<>nil) do begin
ProcCode:=ASourceChangeCache.BeautifyCodeOptions.AddClassNameToProc(
TCodeTreeNodeExtension(MissingNode.Data).ExtTxt1,
TheClassName);
ProcCode:=ASourceChangeCache.BeautifyCodeOptions.BeautifyProc(
ANodeExt:=TCodeTreeNodeExtension(MissingNode.Data);
ProcCode:=ANodeExt.ExtTxt1;
if (ProcCode='') then begin
ANode:=TCodeTreeNodeExtension(MissingNode.Data).Node;
if (ANode<>nil) and (ANode.Desc=ctnProcedure) then begin
ProcCode:=ExtractProcHead(ANode,[phpWithStart,phpAddClassname,
phpWithParameterNames,phpWithResultType,phpWithVarModifiers]);
end;
end;
if ProcCode<>'' then begin
ProcCode:=ASourceChangeCache.BeautifyCodeOptions.BeautifyProc(
ProcCode,Indent,true);
ASourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,
ProcCode);
MissingNode:=ProcBodyNodes.FindSuccessor(MissingNode);
ASourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,
InsertPos,ProcCode);
if JumpToProc='' then begin
// remember a proc body to set the cursor at
JumpToProc:=ANodeExt.Txt;
end;
end;
MissingNode:=ProcBodyNodes.FindPrecessor(MissingNode);
end;
end else begin
// there were old class procs already
// -> search a good Insert Position behind or in front of
// another proc body of this class
case ASourceChangeCache.BeautifyCodeOptions.ProcedureInsertPolicy of
pipAlphabetically:
while (MissingNode<>nil) do begin
if ExistingNode<>nil then
cmp:=CompareTextIgnoringSpace(
TCodeTreeNodeExtension(MissingNode.Data).Txt,
TCodeTreeNodeExtension(ExistingNode.Data).Txt,true)
else
cmp:=-1;
if cmp<0 then begin
// MissingNode does not have a body -> insert proc body
if ASourceChangeCache.BeautifyCodeOptions.ProcedureInsertPolicy
<>pipAlphabetically then
begin
Indent:=GetLineIndent(Src,LastExistingProcBody.StartPos);
InsertPos:=FindLineEndOrCodeAfterPosition(Src,
LastExistingProcBody.EndPos,Scanner.NestedComments);
end;
while (MissingNode<>nil) do begin
if ExistingNode<>nil then
cmp:=CompareTextIgnoringSpace(
TCodeTreeNodeExtension(MissingNode.Data).Txt,
TCodeTreeNodeExtension(ExistingNode.Data).Txt,true)
else
cmp:=1;
if cmp>0 then begin
// MissingNode does not have a body -> insert proc body
case ASourceChangeCache.BeautifyCodeOptions.ProcedureInsertPolicy of
pipAlphabetically:
if ExistingNode<>nil then begin
// insert in front of ExistingNode
// insert behind ExistingNode
ANodeExt:=TCodeTreeNodeExtension(ExistingNode.Data);
ANode:=ANodeExt.Node;
Indent:=GetLineIndent(Src,ANode.StartPos);
InsertPos:=FindLineEndOrCodeInFrontOfPosition(Src,
ANode.StartPos,Scanner.NestedComments);
InsertPos:=FindLineEndOrCodeAfterPosition(Src,
ANode.EndPos,Scanner.NestedComments);
end else begin
// insert behind last existing proc body
Indent:=GetLineIndent(Src,LastExistingProcBody.StartPos);
InsertPos:=FindLineEndOrCodeAfterPosition(Src,
LastExistingProcBody.EndPos,Scanner.NestedComments);
end;
end;
ANodeExt:=TCodeTreeNodeExtension(MissingNode.Data);
ProcCode:=ANodeExt.ExtTxt1;
if (ProcCode='') then begin
ANode:=ANodeExt.Node;
if (ANode<>nil) and (ANode.Desc=ctnProcedure) then begin
ProcCode:=ExtractProcHead(ANode,[phpWithStart,phpAddClassname,
phpWithParameterNames,phpWithResultType,phpWithVarModifiers]);
end;
end;
if (ProcCode<>'') then begin
ProcCode:=
ASourceChangeCache.BeautifyCodeOptions.AddClassNameToProc(
TCodeTreeNodeExtension(MissingNode.Data).ExtTxt1,
TheClassName);
ProcCode,TheClassName);
ProcCode:=ASourceChangeCache.BeautifyCodeOptions.BeautifyProc(
ProcCode,Indent,true);
ASourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,
InsertPos,InsertPos,ProcCode);
MissingNode:=ProcBodyNodes.FindSuccessor(MissingNode);
end else if cmp>0 then
ExistingNode:=ProcBodyNodes.FindSuccessor(ExistingNode)
else
MissingNode:=ProcBodyNodes.FindSuccessor(MissingNode);
end;
else // case ProcedureInsertPolicy else
begin
// insert all missing proc bodies behind last existing proc body
Indent:=GetLineIndent(Src,LastExistingProcBody.StartPos);
InsertPos:=FindLineEndOrCodeAfterPosition(Src,
LastExistingProcBody.EndPos,Scanner.NestedComments);
while (MissingNode<>nil) do begin
ProcCode:=
ASourceChangeCache.BeautifyCodeOptions.AddClassNameToProc(
TCodeTreeNodeExtension(MissingNode.Data).ExtTxt1,
TheClassName);
ProcCode:=ASourceChangeCache.BeautifyCodeOptions.BeautifyProc(
ProcCode,Indent,true);
ASourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,
InsertPos,InsertPos,ProcCode);
MissingNode:=ProcBodyNodes.FindSuccessor(MissingNode);
if JumpToProc='' then begin
// remember a proc body to set the cursor at
JumpToProc:=ANodeExt.Txt;
end;
end;
end;
end; // case end
MissingNode:=ProcBodyNodes.FindPrecessor(MissingNode);
end else if cmp<0 then
ExistingNode:=ProcBodyNodes.FindPrecessor(ExistingNode)
else
MissingNode:=ProcBodyNodes.FindPrecessor(MissingNode);
end;
end;
Result:=true;
finally
ClassProcs.FreeAndClear;
ClassProcs.Free;
if ClassProcs<>nil then begin
ClassProcs.FreeAndClear;
ClassProcs.Free;
end;
ProcBodyNodes.FreeAndClear;
ProcBodyNodes.Free;
end;
@ -7000,7 +7042,7 @@ end;
function TCodeCompletionCodeTool.CompleteCode(CursorPos: TCodeXYPosition;
var NewPos: TCodeXYPosition; var NewTopLine: integer;
SourceChangeCache: TSourceChangeCache): boolean;
var CleanCursorPos, Indent, insertPos: integer;
var CleanCursorPos, Dummy, Indent, insertPos: integer;
CursorNode, ProcNode, ImplementationNode, SectionNode,
ANode: TCodeTreeNode;
ProcCode: string;
@ -7015,8 +7057,8 @@ begin
ASourceChangeCache:=SourceChangeCache;
SourceChangeCache.MainScanner:=Scanner;
// find the CursorPos in cleaned source
CleanCursorPos:=CaretToCleanPos(CursorPos, CleanCursorPos);
if (CleanCursorPos<>0) and (CleanCursorPos<>-1) then exit;
Dummy:=CaretToCleanPos(CursorPos, CleanCursorPos);
if (Dummy<>0) and (Dummy<>-1) then exit;
// find CodeTreeNode at cursor
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos);
if CursorNode=nil then
@ -7026,7 +7068,7 @@ writeln('TCodeCompletionCodeTool.CompleteCode A ',NodeDescriptionAsString(Cursor
{$ENDIF}
InInterface:=NodeHasParentOfType(CursorNode,ctnInterface);
ImplementationNode:=FindImplementationNode;
if ImplementationNode=nil then exit;
if ImplementationNode=nil then ImplementationNode:=Tree.Root;
FirstInsert:=nil;
// first test if in a class
@ -7054,6 +7096,9 @@ writeln('TCodeCompletionCodeTool.CompleteCode C ',CleanCursorPos,', |',copy(Src,
// go through all properties and procs
// insert read + write prop specifiers
// demand Variables + Procs + Proc Bodies
{$IFDEF CTDEBUG}
writeln('TCodeCompletionCodeTool.CompleteCode Complete Properties ... ');
{$ENDIF}
SectionNode:=ClassNode.FirstChild;
while SectionNode<>nil do begin
ANode:=SectionNode.FirstChild;
@ -7067,15 +7112,24 @@ writeln('TCodeCompletionCodeTool.CompleteCode C ',CleanCursorPos,', |',copy(Src,
SectionNode:=SectionNode.NextBrother;
end;
{$IFDEF CTDEBUG}
writeln('TCodeCompletionCodeTool.CompleteCode Insert new variables and methods ... ');
{$ENDIF}
// insert all new variables and procs definitions
if not InsertAllNewClassParts then exit;
{$IFDEF CTDEBUG}
writeln('TCodeCompletionCodeTool.CompleteCode Insert new method bodies ... ');
{$ENDIF}
// insert all missing proc bodies
if not CreateMissingProcBodies then exit;
{$IFDEF CTDEBUG}
writeln('TCodeCompletionCodeTool.CompleteCode Apply ... ');
{$ENDIF}
// apply the changes and jump to first new proc body
if not SourceChangeCache.Apply then exit;
if JumpToProc<>'' then begin
// there was a new proc body
// -> find it and jump to
@ -7084,8 +7138,8 @@ writeln('TCodeCompletionCodeTool.CompleteCode C ',CleanCursorPos,', |',copy(Src,
BuildTree(false);
if not EndOfSourceFound then exit;
// find the CursorPos in cleaned source
CleanCursorPos:=CaretToCleanPos(CursorPos, CleanCursorPos);
if (CleanCursorPos<>0) and (CleanCursorPos<>-1) then exit;
Dummy:=CaretToCleanPos(CursorPos, CleanCursorPos);
if (Dummy<>0) and (Dummy<>-1) then exit;
// find CodeTreeNode at cursor
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos);
if CursorNode=nil then exit;

32
components/codetools/sourcechanger.pas
View File

@ -334,7 +334,7 @@ function TSourceChangeCache.Apply: boolean;
var CurNode, PrecNode: TAVLTreeNode;
CurEntry, PrecEntry, FirstEntry: TSourceChangeCacheEntry;
InsertText: string;
i, NeededLineEnds: integer;
i, j, NeededLineEnds, NeededIndent: integer;
BetweenGap: TGapTyp;
Abort: boolean;
begin
@ -378,6 +378,15 @@ writeln('TSourceChangeCache.Apply Pos=',FirstEntry.FromPos,'-',FirstEntry.ToPos,
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;
@ -708,7 +717,8 @@ begin
Result:=BeautifyStatement(AProcCode,IndentSize);
if AddBeginEnd then begin
SetLength(IndentStr,IndentSize);
FillChar(IndentStr[1],length(IndentStr),' ');
if IndentSize>0 then
FillChar(IndentStr[1],length(IndentStr),' ');
AddAtom(Result,LineEnd+IndentStr);
AddAtom(Result,'begin');
AddAtom(Result,LineEnd+LineEnd+IndentStr);
@ -726,9 +736,11 @@ begin
SrcLen:=length(Src);
if IndentSize>=LineLength-10 then IndentSize:=LineLength-10;
SetLength(Result,IndentSize);
FillChar(Result[1],length(Result),' ');
if IndentSize>0 then
FillChar(Result[1],length(Result),' ');
SetLength(IndentStr,IndentSize+Indent);
FillChar(IndentStr[1],length(IndentStr),' ');
if length(IndentStr)>0 then
FillChar(IndentStr[1],length(IndentStr),' ');
CurPos:=1;
LastSplitPos:=-1;
CurLineLen:=length(Result);
@ -753,7 +765,7 @@ end;
function TBeautifyCodeOptions.AddClassNameToProc(
const AProcCode, AClassName: string): string;
var StartPos, ProcLen: integer;
var StartPos, NamePos, ProcLen: integer;
begin
if CompareSubStrings('CLASS ',AProcCode,1,1,6,false)<>0 then
StartPos:=1
@ -767,8 +779,14 @@ begin
inc(StartPos);
while (StartPos<=ProcLen) and (IsSpaceChar[AProcCode[StartPos]]) do
inc(StartPos);
Result:=copy(AProcCode,1,StartPos-1)+AClassName+'.'
+copy(AProcCode,StartPos,length(AProcCode)-StartPos);
NamePos:=StartPos;
while (StartPos<=ProcLen) and (IsIdentChar[AProcCode[StartPos]]) do
inc(StartPos);
if (StartPos<=ProcLen) and (AProcCode[StartPos]<>'.') then
Result:=copy(AProcCode,1,NamePos-1)+AClassName+'.'
+copy(AProcCode,NamePos,length(AProcCode)-NamePos+1)
else
Result:=AProcCode;
end;
function TBeautifyCodeOptions.BeautifyWord(const AWord: string;

9
ide/ideprocs.pp
View File

@ -17,9 +17,18 @@ const
function FilenameIsAbsolute(TheFilename: string):boolean;
function DirectoryExists(DirectoryName: string): boolean;
function ForceDirectory(DirectoryName: string): boolean;
function ExtractFileNameOnly(const AFilename: string): string;
implementation
function ExtractFileNameOnly(const AFilename: string): string;
var ExtLen: integer;
begin
Result:=ExtractFilename(AFilename);
ExtLen:=length(ExtractFileExt(Result));
Result:=copy(Result,1,length(Result)-ExtLen);
end;
function FilenameIsAbsolute(TheFilename: string):boolean;
begin
DoDirSeparators(TheFilename);

133
ide/main.pp
View File

@ -196,6 +196,10 @@ type
TheEnvironmentOptions: TEnvironmentOptions);
procedure OnSaveEnvironmentSettings(Sender: TObject;
TheEnvironmentOptions: TEnvironmentOptions);
// CodeToolBoss events
procedure OnBeforeCodeToolBossApplyChanges(Manager: TCodeToolManager;
var Abort: boolean);
private
FCodeLastActivated : Boolean; //used for toggling between code and forms
FSelectedComponent : TRegisteredComponent;
@ -270,7 +274,9 @@ type
procedure DoShowMessagesView;
function GetTestProjectFilename: string;
procedure SaveSourceEditorChangesToCodeCache;
procedure ApplyCodeToolChanges;
procedure DoJumpToProcedureSection;
procedure DoCompleteCodeAtCursor;
procedure LoadMainMenu;
procedure LoadSpeedbuttons;
@ -1351,6 +1357,11 @@ begin
Handled:=true;
DoJumpToProcedureSection;
end;
ecCodeCompletion:
begin
Handled:=true;
DoCompleteCodeAtCursor;
end;
end;
end;
@ -2527,8 +2538,10 @@ function TMainIDE.DoSaveProject(SaveAs, SaveToTestDir:boolean):TModalResult;
var MainUnitSrcEdit, ASrcEdit: TSourceEditor;
MainUnitInfo, AnUnitInfo: TUnitInfo;
SaveDialog: TSaveDialog;
NewFilename, NewProgramFilename, NewPageName, AText, ACaption, Ext: string;
NewFilename, NewProgramFilename, NewPageName, NewProgramName, AText, ACaption,
Ext: string;
i, BookmarkID, BookmarkX, BookmarkY :integer;
NewBuf: TCodeBuffer;
begin
Result:=mrCancel;
if ToolStatus<>itNone then begin
@ -2609,7 +2622,7 @@ writeln(' AAA ',Project.ProjectFile);
NewFilename,ProjectDefaultExt[Project.ProjectType]);
if NewFilename=NewProgramFilename then begin
ACaption:='Choose a different name';
AText:='The project info file is "'+NewFilename+'" equal '
AText:='The project info file "'+NewFilename+'"'#13'is equal '
+'to the project source file!';
Result:=MessageDlg(ACaption, AText, mtconfirmation, [mbabort, mbretry], 0);
if Result=mrAbort then exit;
@ -2624,13 +2637,13 @@ writeln(' AAA ',Project.ProjectFile);
if FileExists(NewFilename) then begin
ACaption:='Overwrite file?';
AText:='A file "'+NewFilename+'" already exists. Replace it?';
AText:='A file "'+NewFilename+'" already exists.'#13'Replace it?';
Result:=MessageDlg(ACaption, AText, mtconfirmation, [mbok, mbcancel], 0);
if Result=mrCancel then exit;
end else if Project.ProjectType in [ptProgram, ptApplication] then begin
if FileExists(NewProgramFilename) then begin
ACaption:='Overwrite file?';
AText:='A file "'+NewProgramFilename+'" already exists. Replace it?';
AText:='A file "'+NewProgramFilename+'" already exists.'#13'Replace it?';
Result:=MessageDlg(ACaption, AText, mtconfirmation, [mbok, mbcancel], 0);
if Result=mrCancel then exit;
end;
@ -2638,12 +2651,26 @@ writeln(' AAA ',Project.ProjectFile);
Project.ProjectFile:=NewFilename;
EnvironmentOptions.AddToRecentProjectFiles(NewFilename);
if (MainUnitInfo<>nil) and (MainUnitInfo.Loaded) then begin
// sitch MainUnitInfo to new code
NewBuf:=CodeToolBoss.CreateFile(NewProgramFilename);
if NewBuf=nil then begin
Result:=MessageDlg('Error creating file','Unable to create file'#13
+'"'+NewProgramFilename+'"',mtError,[mbCancel],0);
exit;
end;
NewBuf.Source:=MainUnitInfo.Source.Source;
MainUnitInfo.Source:=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);
NewPageName:=copy(NewpageName,1,length(NewPageName)-length(Ext));
if (Ext='.pp') or (Ext='.pas') then
NewPageName:=copy(NewpageName,1,length(NewPageName)-length(Ext));
NewPageName:=SourceNoteBook.FindUniquePageName(
NewPageName,MainUnitInfo.EditorIndex);
SourceNoteBook.NoteBook.Pages[MainUnitInfo.EditorIndex]:=
@ -3604,6 +3631,7 @@ begin
end;
procedure TMainIDE.SaveSourceEditorChangesToCodeCache;
// save all open sources to code tools cache
var i: integer;
CurUnitInfo: TUnitInfo;
SrcEdit: TSourceEditor;
@ -3622,6 +3650,33 @@ begin
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;
CodeToolBoss.SourceCache.ClearAllSourleLogEntries;
end;
procedure TMainIDE.DoJumpToProcedureSection;
var ActiveSrcEdit, NewSrcEdit: TSourceEditor;
ActiveUnitInfo, NewUnitInfo: TUnitInfo;
@ -3659,6 +3714,46 @@ writeln('[TMainIDE.DoJumpToProcedureSection] ************');
end;
end;
procedure TMainIDE.DoCompleteCodeAtCursor;
var ActiveSrcEdit, NewSrcEdit: TSourceEditor;
ActiveUnitInfo, NewUnitInfo: TUnitInfo;
NewSource: TCodeBuffer;
NewX, NewY, NewTopLine: integer;
begin
if SourceNoteBook.NoteBook=nil then exit;
GetUnitWithPageIndex(SourceNoteBook.NoteBook.PageIndex,ActiveSrcEdit,
ActiveUnitInfo);
if (ActiveSrcEdit=nil) or (ActiveUnitInfo=nil) then exit;
SaveSourceEditorChangesToCodeCache;
CodeToolBoss.VisibleEditorLines:=ActiveSrcEdit.EditorComponent.LinesInWindow;
{$IFDEF IDEDEBUG}
writeln('');
writeln('[TMainIDE.DoJumpToProcedureSection] ************');
{$ENDIF}
if CodeToolBoss.CompleteCode(ActiveUnitInfo.Source,
ActiveSrcEdit.EditorComponent.CaretX,
ActiveSrcEdit.EditorComponent.CaretY,
NewSource,NewX,NewY,NewTopLine) then
begin
ApplyCodeToolChanges;
if NewSource<>ActiveUnitInfo.Source then begin
// jump to other file -> open it
if DoOpenEditorFile(NewSource.Filename,false)<>mrOk then exit;
GetUnitWithPageIndex(SourceNoteBook.NoteBook.PageIndex,NewSrcEdit,
NewUnitInfo);
end else begin
NewSrcEdit:=ActiveSrcEdit;
end;
//writeln('[TMainIDE.DoJumpToProcedureSection] ',NewX,',',NewY,',',NewTopLine);
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
ApplyCodeToolChanges;
end;
end;
procedure TMainIDE.OnDesignerGetSelectedComponentClass(Sender: TObject;
var RegisteredComponent: TRegisteredComponent);
begin
@ -3864,10 +3959,30 @@ begin
Halt;
end;
CodeToolBoss.WriteExceptions:=true;
CodeToolBoss.CatchExceptions:=true;
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}
@ -3881,8 +3996,8 @@ end.
{ =============================================================================
$Log$
Revision 1.117 2001/10/10 22:13:13 lazarus
MG: fixed create project from program file
Revision 1.118 2001/10/12 17:34:23 lazarus
MG: added code completion
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.28 2001/10/10 22:13:13 lazarus
MG: fixed create project from program file
Revision 1.29 2001/10/12 17:34:24 lazarus
MG: added code completion
Revision 1.27 2001/10/09 09:46:50 lazarus
MG: added codetools, fixed synedit unindent, fixed MCatureHandle

26
ide/uniteditor.pp
View File

@ -148,6 +148,7 @@ type
destructor Destroy; override;
Procedure SelectText(LineNum,CharStart,LineNum2,CharEnd : Integer);
Function Close : Boolean;
procedure AdjustMarksByCodeCache;
procedure StartFindAndReplace(Replace:boolean);
procedure OnReplace(Sender: TObject; const ASearch, AReplace:
@ -1188,6 +1189,31 @@ Begin
If Assigned(FOnAfterClose) then FOnAfterClose(Self);
end;
procedure TSourceEditor.AdjustMarksByCodeCache;
var i, NewLine, NewColumn: integer;
ASynMark: TSynEditMark;
ASrc: TCodeBuffer;
begin
// adjust all markers
ASrc:=CodeToolBoss.FindFile(Filename);
if (ASrc=nil) or (ASrc.Count=0) then exit;
i:=FEditor.Marks.Count-1;
while i>0 do begin
ASynMark:=FEditor.Marks[i];
NewLine:=ASynMark.Line;
NewColumn:=ASynMark.Column;
ASrc.AdjustCursor(NewLine,NewColumn);
if NewLine<1 then
FEditor.Marks.Delete(i)
else begin
ASynMark.Line:=NewLine;
ASynMark.Column:=NewColumn;
end;
dec(i);
end;
end;
Procedure TSourceEditor.ReParent(AParent : TWInControl);
Begin
CreateEditor(FAOwner,AParent);