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

MG: many fixes, to make it short: events

Browse Source 
git-svn-id: trunk@1531 -
This commit is contained in:
lazarus 2002-03-22 12:36:47 +00:00
parent 752d661553
commit 17feff57be
9 changed files with 285 additions and 371 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

82
components/codetools/codecompletiontool.pas
View File

@ -43,6 +43,8 @@ interface
{$I codetools.inc}
{ $DEFINE CTDEBUG}
uses
{$IFDEF MEM_CHECK}
MemCheck,
@ -135,12 +137,13 @@ procedure TCodeCompletionCodeTool.SetCodeCompleteClassNode(
const AClassNode: TCodeTreeNode);
begin
FreeClassInsertionList;
BuildSubTreeForClass(ClassNode);
ClassNode:=AClassNode;
BuildSubTreeForClass(ClassNode);
StartNode:=ClassNode.FirstChild;
while (StartNode<>nil) and (StartNode.FirstChild=nil) do
StartNode:=StartNode.NextBrother;
if StartNode<>nil then StartNode:=StartNode.FirstChild;
JumpToProcName:='';
end;
procedure TCodeCompletionCodeTool.SetCodeCompleteSrcChgCache(
@ -256,7 +259,7 @@ function TCodeCompletionCodeTool.NodeExtIsVariable(
//var APos, TxtLen: integer;
begin
Result:=(ANodeExt.Flags=ord(ncpPrivateVars))
or (ANodeExt.Flags=ord(ncpPublishedProcs));
or (ANodeExt.Flags=ord(ncpPublishedVars));
{ APos:=1;
TxtLen:=length(ANodeExt.ExtTxt1);
while (APos<=TxtLen) and (IsIdentChar[ANodeExt.ExtTxt1[APos]]) do
@ -828,7 +831,7 @@ begin
end;
NewPrivatSectionInsertPos:=-1;
NewPrivatSectionIndent:=0;
PublishedNeeded:=false;
PublishedNeeded:=false;// 'published' keyword after first private section needed
PrivatNode:=nil;
// search topmost node of private node extensions
TopMostPrivateNode:=nil;
@ -846,33 +849,34 @@ begin
PrivatNode:=TopMostPrivateNode.Parent.PriorBrother;
while (PrivatNode<>nil) and (PrivatNode.Desc<>ctnClassPrivate) do
PrivatNode:=PrivatNode.PriorBrother;
end;
if PrivatNode=nil then begin
{ Insert a new private section in front of topmost node
normally the best place for a new private section is at the end of
the first published section. But if a privat variable is already
needed in the first published section, then the new private section
must be inserted in front of all }
if (ClassNode.FirstChild.EndPos>TopMostPrivateNode.StartPos) then begin
// topmost node is in the first section
// -> insert as the first section
ANode:=ClassNode.FirstChild;
NewPrivatSectionIndent:=GetLineIndent(Src,ANode.StartPos);
if (ANode.FirstChild<>nil) and (ANode.FirstChild.Desc<>ctnClassGUID) then
NewPrivatSectionInsertPos:=ANode.StartPos
else
NewPrivatSectionInsertPos:=ANode.FirstChild.EndPos;
PublishedNeeded:=CompareNodeIdentChars(ANode,'PUBLISHED')<>0;
end else begin
// default: insert new privat section behind first published section
ANode:=ClassNode.FirstChild;
NewPrivatSectionIndent:=GetLineIndent(Src,ANode.StartPos);
NewPrivatSectionInsertPos:=ANode.EndPos;
if (PrivatNode=nil) then begin
{ Insert a new private section in front of topmost node
normally the best place for a new private section is at the end of
the first published section. But if a privat variable is already
needed in the first published section, then the new private section
must be inserted in front of all }
if (ClassNode.FirstChild.EndPos>TopMostPrivateNode.StartPos) then begin
// topmost node is in the first section
// -> insert as the first section
ANode:=ClassNode.FirstChild;
NewPrivatSectionIndent:=GetLineIndent(Src,ANode.StartPos);
if (ANode.FirstChild<>nil) and (ANode.FirstChild.Desc<>ctnClassGUID)
then
NewPrivatSectionInsertPos:=ANode.StartPos
else
NewPrivatSectionInsertPos:=ANode.FirstChild.EndPos;
PublishedNeeded:=CompareNodeIdentChars(ANode,'PUBLISHED')<>0;
end else begin
// default: insert new privat section behind first published section
ANode:=ClassNode.FirstChild;
NewPrivatSectionIndent:=GetLineIndent(Src,ANode.StartPos);
NewPrivatSectionInsertPos:=ANode.EndPos;
end;
ASourceChangeCache.Replace(gtNewLine,gtNewLine,
NewPrivatSectionInsertPos,NewPrivatSectionInsertPos,
GetIndentStr(NewPrivatSectionIndent)+
ASourceChangeCache.BeautifyCodeOptions.BeautifyKeyWord('private'));
end;
ASourceChangeCache.Replace(gtNewLine,gtNewLine,
NewPrivatSectionInsertPos,NewPrivatSectionInsertPos,
GetIndentStr(NewPrivatSectionIndent)+
ASourceChangeCache.BeautifyCodeOptions.BeautifyKeyWord('private'));
end;
InsertNewClassParts(ncpPrivateVars);
@ -896,6 +900,9 @@ procedure TCodeCompletionCodeTool.AddNewPropertyAccessMethodsToClassProcs(
var ANodeExt: TCodeTreeNodeExtension;
NewNodeExt: TCodeTreeNodeExtension;
begin
{$IFDEF CTDEBUG}
writeln('[TCodeCompletionCodeTool.AddNewPropertyAccessMethodsToClassProcs]');
{$ENDIF}
// add new property access methods to ClassProcs
ANodeExt:=FirstInsert;
while ANodeExt<>nil do begin
@ -928,6 +935,9 @@ var AnAVLNode: TAVLTreeNode;
BeautifyCodeOptions: TBeautifyCodeOptions;
begin
if not AddInheritedCodeToOverrideMethod then exit;
{$IFDEF CTDEBUG}
writeln('[TCodeCompletionCodeTool.CheckForOverrideAndAddInheritedCode]');
{$ENDIF}
BeautifyCodeOptions:=ASourceChangeCache.BeautifyCodeOptions;
AnAVLNode:=ClassProcs.FindLowest;
while AnAVLNode<>nil do begin
@ -1118,7 +1128,10 @@ writeln('TCodeCompletionCodeTool.CreateMissingProcBodies Gather existing method
// search for missing proc bodies
if (ProcBodyNodes.Count=0) then begin
// there were no old proc bodies of the class -> start class
{$IFDEF CTDEBUG}
writeln('TCodeCompletionCodeTool.CreateMissingProcBodies Starting class in implementation ');
{$ENDIF}
if NodeHasParentOfType(ClassNode,ctnInterface) then begin
// class is in interface section
// -> insert at the end of the implementation section
@ -1185,7 +1198,10 @@ writeln('TCodeCompletionCodeTool.CreateMissingProcBodies Gather existing method
// there were old class procs already
// -> search a good Insert Position behind or in front of
// another proc body of this class
{$IFDEF CTDEBUG}
writeln('TCodeCompletionCodeTool.CreateMissingProcBodies Insert missing bodies between existing ... ClassProcs.Count=',ClassProcs.Count);
{$ENDIF}
// set default insert position
Indent:=GetLineIndent(Src,LastExistingProcBody.StartPos);
InsertPos:=FindLineEndOrCodeAfterPosition(Src,
@ -1293,6 +1309,9 @@ writeln('TCodeCompletionCodeTool.CreateMissingProcBodies Gather existing method
ProcCode,TheClassName,'');
ProcCode:=ASourceChangeCache.BeautifyCodeOptions.BeautifyProc(
ProcCode,Indent,ANodeExt.ExtTxt3='');
{$IFDEF CTDEBUG}
writeln('TCodeCompletionCodeTool.CreateMissingProcBodies Inserting Method Body: "',ProcCode,'" -----');
{$ENDIF}
ASourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,
InsertPos,InsertPos,ProcCode);
if JumpToProcName='' then begin
@ -1352,7 +1371,6 @@ writeln('TCodeCompletionCodeTool.CompleteCode In-a-class ',NodeDescriptionAsStri
writeln('TCodeCompletionCodeTool.CompleteCode C ',CleanCursorPos,', |',copy(Src,CleanCursorPos,8));
{$ENDIF}
CodeCompleteClassNode:=AClassNode;
JumpToProcName:='';
try
// go through all properties and procs
// insert read + write prop specifiers

273
components/codetools/eventcodetool.pas
View File

@ -34,7 +34,7 @@ interface
{$I codetools.inc}
{ $DEFINE CTDEBUG}
{$DEFINE CTDEBUG}
uses
{$IFDEF MEM_CHECK}
@ -55,9 +55,6 @@ type
function FindIdentifierNodeInClass(ClassNode: TCodeTreeNode;
Identifier: PChar): TCodeTreeNode;
protected
function InsertNewMethodToClass(ClassSectionNode: TCodeTreeNode;
const AMethodName,NewMethod: string;
SourceChangeCache: TSourceChangeCache): boolean;
function CollectPublishedMethods(Params: TFindDeclarationParams;
FoundContext: TFindContext): TIdentifierFoundResult;
public
@ -299,7 +296,7 @@ begin
if SectionNode=nil then exit;
ANode:=SectionNode.FirstChild;
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.FindProcNodeInImplementation] A');
writeln('[TEventsCodeTool.FindMethodNodeInImplementation] A MethodName=',UpperClassName,'.',UpperMethodName);
{$ENDIF}
while (ANode<>nil) do begin
if (ANode.Desc=ctnProcedure) and (ANode.FirstChild<>nil)
@ -312,6 +309,9 @@ writeln('[TEventsCodeTool.FindProcNodeInImplementation] A');
ReadNextAtom;
if CompareSrcIdentifiers(CurPos.StartPos,@UpperMethodName[1]) then
begin
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.FindMethodNodeInImplementation] B body found');
{$ENDIF}
Result:=ANode;
exit;
end;
@ -456,7 +456,6 @@ var ANode: TCodeTreeNode;
begin
// ToDo: method overloading
ANode:=FindMethodNodeInImplementation(UpperClassName,UpperMethodName,true);
Result:=FindJumpPointInProcNode(ANode,NewPos,NewTopLine);
end;
@ -540,25 +539,45 @@ begin
Result:=false;
if (ClassNode=nil) or (ClassNode.Desc<>ctnClass) or (AMethodName='')
or (ATypeInfo=nil) or (SourceChangeCache=nil) or (Scanner=nil) then exit;
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CreatePublishedMethod] A AMethodName="',AMethodName,'"');
{$ENDIF}
// search typeinfo in source
FindContext:=FindMethodTypeInfo(ATypeInfo);
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CreatePublishedMethod] B');
{$ENDIF}
// initialize class for code completion
CodeCompleteClassNode:=ClassNode;
CodeCompleteSrcChgCache:=SourceChangeCache;
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CreatePublishedMethod] C');
{$ENDIF}
// check if method definition already exists in class
CleanMethodDefinition:=AMethodName
CleanMethodDefinition:=UpperCaseStr(AMethodName)
+FindContext.Tool.ExtractProcHead(FindContext.Node,
[phpWithoutClassName, phpWithoutName, phpInUpperCase]);
if not ProcExistsInCodeCompleteClass(CleanMethodDefinition) then begin
// insert method definition to class
MethodDefinition:=AMethodName
+FindContext.Tool.ExtractProcHead(FindContext.Node,
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CreatePublishedMethod] insert method definition to class');
{$ENDIF}
// insert method definition into class
MethodDefinition:=TrimCodeSpace(FindContext.Tool.ExtractProcHead(
FindContext.Node,
[phpWithStart, phpWithoutClassKeyword, phpWithoutClassName,
phpWithoutName, phpWithVarModifiers, phpWithParameterNames,
phpWithDefaultValues, phpWithResultType, phpInUpperCase]);
phpWithDefaultValues, phpWithResultType]));
MethodDefinition:=SourceChangeCache.BeautifyCodeOptions.
AddClassAndNameToProc(MethodDefinition, '', AMethodName);
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CreatePublishedMethod] MethodDefinition="',MethodDefinition,'"');
{$ENDIF}
AddClassInsertion(nil, CleanMethodDefinition, MethodDefinition, AMethodName,
'', ncpPublishedProcs);
end;
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CreatePublishedMethod] invoke class completion');
{$ENDIF}
if not InsertAllNewClassParts then
RaiseException('error during inserting new class parts');
@ -566,238 +585,12 @@ begin
if not CreateMissingProcBodies then
RaiseException('error during creation of new proc bodies');
// apply the changes and jump to first new proc body
// apply the changes
if not SourceChangeCache.Apply then
RaiseException('unable to apply changes');
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CreatePublishedMethod] END');
{$ENDIF}
end;
function TEventsCodeTool.InsertNewMethodToClass(
ClassSectionNode: TCodeTreeNode; const AMethodName,NewMethod: string;
SourceChangeCache: TSourceChangeCache): boolean;
// NewMethod is for example 'class function Lol(c: char): char;'
var InsertNode, ClassNode, ImplementationNode, StartNode, ANode: TCodeTreeNode;
Indent, InsertPos, cmp: integer;
UpperMethodName, CurProcName, ProcCode, UpperClassName,
AClassName: string;
StartClassCode: boolean;
ClassBodyProcs: TAVLTree;
AnAVLNode: TAVLTreeNode;
begin
Result:=false;
if (ClassSectionNode=nil) or (SourceChangeCache=nil) or (AMethodName='')
or (NewMethod='') then exit;
ClassNode:=ClassSectionNode.Parent;
if ClassNode=nil then exit;
AClassName:=ExtractClassName(ClassNode,false);
UpperClassName:=UpperCaseStr(AClassName);
UpperMethodName:=UpperCaseStr(AMethodName);
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.InsertNewMethodToClass] A ',
ClassSectionNode.FirstChild<>nil,' "',NewMethod,'"');
{$ENDIF}
// find a nice inserting position
if ClassSectionNode.FirstChild<>nil then begin
// there are already other child nodes
if (cpipLast=SourceChangeCache.BeautifyCodeOptions.ClassPartInsertPolicy)
then begin
// insert as last
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.InsertNewMethodToClass] B');
{$ENDIF}
InsertNode:=ClassSectionNode.LastChild;
Indent:=GetLineIndent(Src,InsertNode.StartPos);
InsertPos:=FindFirstLineEndAfterInCode(Src,InsertNode.EndPos,
Scanner.NestedComments);
end else begin
// insert alphabetically
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.InsertNewMethodToClass] C');
{$ENDIF}
InsertNode:=ClassSectionNode.FirstChild;
while (InsertNode<>nil) do begin
if (InsertNode.Desc=ctnProcedure) then begin
CurProcName:=ExtractProcName(InsertNode,true);
if CurProcName>UpperMethodName then
break;
end;
InsertNode:=InsertNode.NextBrother;
end;
if InsertNode<>nil then begin
// insert before insertnode
if InsertNode.PriorBrother<>nil then begin
// insert after InsertNode.PriorBrother
InsertNode:=InsertNode.PriorBrother;
Indent:=GetLineIndent(Src,InsertNode.StartPos);
InsertPos:=FindFirstLineEndAfterInCode(Src,InsertNode.EndPos,
Scanner.NestedComments);
end else begin
// insert as first
Indent:=GetLineIndent(Src,InsertNode.StartPos);
InsertPos:=FindFirstLineEndAfterInCode(Src,
ClassSectionNode.EndPos,Scanner.NestedComments);
end;
end else begin
// insert as last
InsertNode:=ClassSectionNode.LastChild;
Indent:=GetLineIndent(Src,InsertNode.StartPos);
InsertPos:=FindLineEndOrCodeAfterPosition(Src,InsertNode.EndPos,
Scanner.NestedComments);
end;
end;
end else begin
// will become first and only child node of section
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.InsertNewMethodToClass] D');
{$ENDIF}
Indent:=GetLineIndent(Src,ClassSectionNode.StartPos)
+SourceChangeCache.BeautifyCodeOptions.Indent;
InsertPos:=FindLineEndOrCodeAfterPosition(Src,
ClassSectionNode.StartPos,Scanner.NestedComments);
end;
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.InsertNewMethodToClass] E');
{$ENDIF}
ProcCode:=SourceChangeCache.BeautifyCodeOptions.AddClassAndNameToProc(
NewMethod,'',AMethodName);
ProcCode:=SourceChangeCache.BeautifyCodeOptions.BeautifyProc(
ProcCode,Indent,false);
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.InsertNewMethodToClass] E2 ProcCode="',ProcCode,'"');
{$ENDIF}
if not SourceChangeCache.Replace(gtNewLine,gtNewLine,InsertPos,InsertPos,
ProcCode) then exit;
// add method body to implementation section
ImplementationNode:=FindImplementationNode;
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.InsertNewMethodToClass] F ',ImplementationNode<>nil);
{$ENDIF}
if ImplementationNode=nil then exit;
StartNode:=ImplementationNode.FirstChild;
if StartNode<>nil then begin
// implementation section contains some procs or classes
// gather proc nodes in implementation section
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.InsertNewMethodToClass] G');
{$ENDIF}
ClassBodyProcs:=GatherProcNodes(StartNode,
[phpInUpperCase,phpIgnoreForwards,phpOnlyWithClassname,
phpWithoutClassName],UpperClassName);
// ToDo: check if proc already exists
StartClassCode:=(ClassBodyProcs.Count=0);
UpperMethodName:=UpperClassName+'.'+UpperMethodName;
if not StartClassCode then begin
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.InsertNewMethodToClass] H');
{$ENDIF}
// find a nice insert position for the proc body
case SourceChangeCache.BeautifyCodeOptions.MethodInsertPolicy of
mipAlphabetically:
// insert proc in alphabetic order
begin
AnAVLNode:=ClassBodyProcs.Root;
while AnAVLNode<>nil do begin
InsertNode:=TCodeTreeNodeExtension(AnAVLNode.Data).Node;
CurProcName:=ExtractProcName(InsertNode,true);
cmp:=AnsiCompareStr(UpperMethodName,CurProcName);
if cmp<0 then
AnAVLNode:=AnAVLNode.Left
else if cmp>0 then
AnAVLNode:=AnAVLNode.Right
else
break;
end;
repeat
AnAVLNode:=ClassBodyProcs.FindSuccessor(AnAVLNode);
if AnAVLNode=nil then break;
ANode:=TCodeTreeNodeExtension(AnAVLNode.Data).Node;
CurProcName:=ExtractProcName(ANode,true);
cmp:=AnsiCompareStr(UpperMethodName,CurProcName);
if cmp=0 then
InsertNode:=ANode;
until cmp<>0;
CurProcName:=ExtractProcName(InsertNode,true);
cmp:=AnsiCompareStr(UpperMethodName,CurProcName);
if cmp<0 then begin
// insert in front of InsertNode
Indent:=GetLineIndent(Src,InsertNode.StartPos);
InsertPos:=FindLineEndOrCodeInFrontOfPosition(Src,
InsertNode.StartPos-1,Scanner.NestedComments);
if InsertPos<1 then InsertPos:=1;
end else begin
// insert behind InsertNode
Indent:=GetLineIndent(Src,InsertNode.StartPos);
InsertPos:=FindLineEndOrCodeAfterPosition(Src,
InsertNode.EndPos,Scanner.NestedComments);
end;
end;
else // mipLast
// ToDo: mipClassOrder
// insert proc body behind last proc body
begin
AnAVLNode:=ClassBodyProcs.FindLowest;
InsertNode:=TCodeTreeNodeExtension(AnAVLNode.Data).Node;
while (AnAVLNode<>nil) do begin
ANode:=TCodeTreeNodeExtension(AnAVLNode.Data).Node;
if InsertNode.StartPos<ANode.StartPos then
InsertNode:=ANode;
AnAVLNode:=ClassBodyProcs.FindSuccessor(AnAVLNode);
end;
// insert after InsertNode
Indent:=GetLineIndent(Src,InsertNode.StartPos);
InsertPos:=FindLineEndOrCodeAfterPosition(Src,
InsertNode.EndPos,Scanner.NestedComments);
end;
end;
end else begin
// this is the first class body
// -> add proc body at the end of the implementation section
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.InsertNewMethodToClass] I');
{$ENDIF}
Indent:=GetLineIndent(Src,InsertNode.StartPos);
InsertPos:=ImplementationNode.EndPos;
end;
end else begin
// implementation section contains no procs or classes
// -> add proc body at the end of the implementation section
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.InsertNewMethodToClass] J');
{$ENDIF}
StartClassCode:=true;
Indent:=GetLineIndent(Src,ImplementationNode.StartPos);
InsertPos:=ImplementationNode.EndPos;
end;
// insert classname to Method string
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.InsertNewMethodToClass] K');
{$ENDIF}
ProcCode:=SourceChangeCache.BeautifyCodeOptions.AddClassAndNameToProc(
NewMethod,AClassName,AMethodName);
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.InsertNewMethodToClass] L ProcCode="',ProcCode,'"');
{$ENDIF}
// build nice proc
ProcCode:=SourceChangeCache.BeautifyCodeOptions.BeautifyProc(ProcCode,
Indent,true);
if StartClassCode then
ProcCode:=SourceChangeCache.BeautifyCodeOptions.LineEnd
+GetIndentStr(Indent)+'{ '+AClassName+' }'
+SourceChangeCache.BeautifyCodeOptions.LineEnd
+ProcCode;
if not SourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,
ProcCode) then exit;
Result:=true;
end;
@ -863,7 +656,7 @@ writeln('[TEventsCodeTool.CreateExprListFromMethodTypeData] B ',
);
{$ENDIF}
Result.Add(CurExprType);
Result.AddFirst(CurExprType);
Params.Load(OldInput);
{// build string
@ -902,7 +695,7 @@ begin
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CollectPublishedMethods] ',
' Node=',FoundContext.Node.DescAsString,
' "',copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,20),'"',
' "',copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50),'"',
' Tool=',FoundContext.Tool.MainFilename);
{$ENDIF}
FirstParameterNode:=FoundContext.Tool.GetFirstParameterNode(

40
components/codetools/finddeclarationtool.pas
View File

@ -184,10 +184,17 @@ const
type
// TExprTypeList is used for compatibility checks of whole parameter lists
TExprTypeList = class
private
FCapacity: integer;
procedure SetCapacity(const AValue: integer);
protected
procedure Grow;
public
Count: integer;
Items: ^TExpressionType;
procedure Add(ExprType: TExpressionType);
procedure AddFirst(ExprType: TExpressionType);
property Capacity: integer read FCapacity write SetCapacity;
destructor Destroy; override;
function AsString: string;
end;
@ -4298,18 +4305,41 @@ begin
end;
end;
procedure TExprTypeList.SetCapacity(const AValue: integer);
var NewSize: integer;
begin
if FCapacity=AValue then exit;
FCapacity:=AValue;
NewSize:=FCapacity*SizeOf(TExpressionType);
if Items=nil then
GetMem(Items,NewSize)
else
ReAllocMem(Items,NewSize);
if Count>Capacity then Count:=Capacity;
end;
procedure TExprTypeList.Grow;
begin
Capacity:=Capacity+5;
end;
procedure TExprTypeList.Add(ExprType: TExpressionType);
var NewSize: integer;
begin
inc(Count);
NewSize:=Count*SizeOf(TExpressionType);
if Count=1 then
GetMem(Items,NewSize)
else
ReAllocMem(Items,NewSize);
if Count>Capacity then Grow;
Items[Count-1]:=ExprType;
end;
procedure TExprTypeList.AddFirst(ExprType: TExpressionType);
begin
inc(Count);
if Count>Capacity then Grow;
if Count>1 then
Move(Items[0],Items[1],SizeOf(TExpressionType)*(Count-1));
Items[0]:=ExprType;
end;
end.

1
components/codetools/methodjumptool.pas
View File

@ -572,6 +572,7 @@ var DestNode: TCodeTreeNode;
i, NewCleanPos: integer;
begin
Result:=false;
if ProcNode=nil then exit;
// search method body
DestNode:=FindProcBody(ProcNode);
if DestNode=nil then begin

19
designer/jitforms.pp
View File

@ -364,13 +364,18 @@ end;
function TJITForms.CreateNewMethod(JITForm: TForm; AName: ShortString): TMethod;
var CodeTemplate,NewCode:Pointer;
CodeSize:integer;
OldCode: Pointer;
begin
if JITForm=nil then
raise Exception.Create('TJITForms.CreateNewMethod JITForm=nil');
if IndexOf(JITForm)<0 then
raise Exception.Create('TJITForms.CreateNewMethod JITForm.ClassName='+
JITForm.ClassName);
if JITForm.MethodAddress(AName)<>nil then exit;
OldCode:=JITForm.MethodAddress(AName);
if OldCode<>nil then begin
Result.Code:=OldCode;
Result.Data:=JITForm;
end;
CodeTemplate:=MethodAddress('DoNothing');
CodeSize:=100; // !!! what is the real codesize of DoNothing? !!!
GetMem(NewCode,CodeSize);
@ -567,10 +572,16 @@ end;
procedure TJITForms.ReaderFindMethod(Reader: TReader;
const FindMethodName: Ansistring; var Address: Pointer; var Error: Boolean);
var NewMethod: TMethod;
begin
// writeln('[TJITForms.ReaderFindMethod] '''+FindMethodName+'''');
{$IFDEF IDE_DEBUG}
writeln('[TJITForms.ReaderFindMethod] A "'+FindMethodName+'" Address=',HexStr(Cardinal(Address),8));
{$ENDIF}
if Address=nil then begin
AddNewMethod(FCurReadForm,FindMethodName);
// there is no method in the ancestor class with this name
// => add a JIT method with this name to the JITForm
NewMethod:=CreateNewMethod(FCurReadForm,FindMethodName);
Address:=NewMethod.Code;
Error:=false;
end;
end;
@ -578,7 +589,7 @@ end;
procedure TJITForms.ReaderSetName(Reader: TReader; Component: TComponent;
var NewName: Ansistring);
begin
// writeln('[TJITForms.ReaderSetName] OldName='''+Component.Name+''' NewName='''+NewName+'''');
// writeln('[TJITForms.ReaderSetName] OldName="'+Component.Name+'" NewName="'+NewName+'"');
end;
procedure TJITForms.ReaderReferenceName(Reader: TReader; var RefName: Ansistring);

6
designer/objectinspector.pp
View File

@ -362,7 +362,8 @@ begin
OnMouseDown := @CurrentEditMouseDown;
OnDblClick := @CurrentEditDblClick;
OnExit:=@ValueComboBoxExit;
OnChange:=@ValueComboBoxChange;
//OnChange:=@ValueComboBoxChange; the on change event is called even,
// if the user is editing
OnKeyDown:=@ValueComboBoxKeyDown;
end;
@ -562,6 +563,8 @@ begin
NewValue:=ValueEdit.Text
else
NewValue:=ValueComboBox.Text;
if length(NewValue)>CurRow.Editor.GetEditLimit then
NewValue:=LeftStr(NewValue,CurRow.Editor.GetEditLimit);
if NewValue<>CurRow.Editor.GetVisualValue then begin
try
CurRow.Editor.SetValue(NewValue);
@ -674,6 +677,7 @@ begin
ValueComboBox.MaxLength:=NewRow.Editor.GetEditLimit;
ValueComboBox.Items.BeginUpdate;
ValueComboBox.Items.Text:='';
ValueComboBox.Items.Clear;
// XXX
//ValueComboBox.Sorted:=paSortList in Node.Director.GetAttributes;
NewRow.Editor.GetValues(@AddStringToComboBox);

2
ide/include/ide.inc
View File

@ -13,7 +13,7 @@
{ $DEFINE IDE_DEBUG}
{ $DEFINE TestEvents}
{$DEFINE TestEvents}
// end.

222
ide/main.pp
View File

@ -325,7 +325,8 @@ type
procedure OnDebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec);
procedure OnDebuggerWatchChanged(Sender: TObject);
procedure OnDebuggerOutput(Sender: TObject; const AText: String);
procedure OnDebuggerException(Sender: TObject; const AExceptionID: Integer; const AExceptionText: String);
procedure OnDebuggerException(Sender: TObject; const AExceptionID: Integer;
const AExceptionText: String);
// MessagesView events
procedure MessagesViewSelectionChanged(sender : TObject);
@ -344,8 +345,9 @@ type
private
FHintSender : TObject;
FCodeLastActivated : Boolean; //used for toggling between code and forms
FLastFormActivated : TCustomForm; //used to find the last form so you can display the correct tab
FCodeLastActivated : Boolean; // used for toggling between code and forms
FLastFormActivated : TCustomForm;// used to find the last form so you can
// display the correct tab
FSelectedComponent : TRegisteredComponent;
fProject: TProject;
MacroList: TTransferMacroList;
@ -500,12 +502,6 @@ type
end;
const
CapLetters = ['A'..'Z'];
SmallLetters = ['a'..'z'];
Numbers = ['0'..'1'];
var
MainIDE : TMainIDE;
@ -2577,21 +2573,25 @@ CodeToolBoss.SourceCache.WriteAllFileNames;
{$ENDIF}
ResourceCode:=CodeToolBoss.FindNextResourceFile(
ActiveUnitInfo.Source,LinkIndex);
if ResourceCode<>nil then
NewResFileName:=ResourceCode.Filename
else begin
// ToDo: warn for errors in source
NewResFileName:='';
end;
{$IFDEF IDE_DEBUG}
writeln('TMainIDE.DoSaveEditorUnit B2 ',ResourceCode<>nil);
{$ENDIF}
LFMFilename:=ChangeFileExt(ResourceCode.Filename,'.lfm');
if (ResourceCode<>nil) and (not ResourceCode.IsVirtual)
and (ActiveUnitInfo.Form<>nil) and (FileExists(LFMFilename)) then
begin
Result:=DoLoadCodeBuffer(LFMCode,LFMFilename,false,false,true);
if not (Result in [mrOk,mrIgnore]) then exit;
Result:=mrCancel;
if (not ActiveUnitInfo.IsVirtual) and (ActiveUnitInfo.Form<>nil) then begin
LFMFilename:=ChangeFileExt(ActiveUnitInfo.Filename,'.lfm');
if (FileExists(LFMFilename)) then begin
Result:=DoLoadCodeBuffer(LFMCode,LFMFilename,false,false,true);
if not (Result in [mrOk,mrIgnore]) then exit;
Result:=mrCancel;
end;
end;
if ResourceCode<>nil then
NewResFileName:=ResourceCode.Filename
else
NewResFileName:='';
end else begin
ResourceCode:=nil;
NewResFilename:='';
@ -2639,8 +2639,20 @@ writeln('TMainIDE.DoSaveEditorUnit B2 ',ResourceCode<>nil);
else
exit;
end;
if ExtractFileExt(NewFilename)='' then
Ext:=ExtractFileExt(NewFilename);
if Ext='' then begin
NewFilename:=NewFilename+SaveAsFileExt;
Ext:=SaveAsFileExt;
end;
if (Ext='.pas') or (Ext='.pp') then begin
if not IsValidIdent(NewUnitName) then begin
Result:=MessageDlg('Invalid Pascal Identifier',
'The name "'+NewUnitName+'" is not a valid pascal identifier.'
,mtWarning,[mbIgnore,mbCancel],0);
if Result=mrCancel then exit;
Result:=mrCancel;
end;
end;
if EnvironmentOptions.PascalFileLowerCase then
NewFileName:=ExtractFilePath(NewFilename)
+lowercase(ExtractFileName(NewFilename));
@ -2658,24 +2670,20 @@ writeln('TMainIDE.DoSaveEditorUnit B2 ',ResourceCode<>nil);
if MessageDlg(ACaption, AText, mtConfirmation,[mbCancel],0)
=mrCancel then exit;
end;
if ResourceCode=nil then begin
// there are no resource files -> remove any resource files in the
// destination
if ActiveUnitInfo.FormName='' then begin
// unit has no form
// -> remove lfm file, so that it will not be auto loaded on next open
NewResFilename:=ChangeFileExt(NewFilename,'.lfm');
if (not DeleteFile(NewResFilename))
and (MessageDlg('Delete failed','Deleting of file "'+NewResFilename+'"'
+' failed.',mtError,[mbIgnore,mbCancel],0)=mrCancel) then exit;
NewResFilename:=ChangeFileExt(NewFilename,'.lrs');
if (not DeleteFile(NewResFilename))
and (MessageDlg('Delete failed','Deleting of file "'+NewResFilename+'"'
+' failed.',mtError,[mbIgnore,mbCancel],0)=mrCancel) then exit;
end;
// save source in the new position
EnvironmentOptions.AddToRecentOpenFiles(NewFilename);
if not CodeToolBoss.SaveBufferAs(ActiveUnitInfo.Source,NewFilename,
NewSource) then exit;
if ResourceCode<>nil then begin
// rename Resource file and form text file
// rename Resource file
// the resource include line in the code will be changed later after
// changing the unitname
NewResFilePath:=ExtractFilePath(ResourceCode.Filename);
@ -2710,7 +2718,8 @@ writeln('TMainIDE.DoSaveEditorUnit C ',ResourceCode<>nil);
{$ENDIF}
ActiveUnitInfo.Source:=NewSource;
ActiveUnitInfo.Modified:=false;
ActiveSrcEdit.CodeBuffer:=NewSource; // the code is not changed, thus the marks are kept
ActiveSrcEdit.CodeBuffer:=NewSource; // the code is not changed,
// therefore the marks are kept
// change unitname in project and in source
Ext:=ExtractFileExt(NewFilename);
ActiveUnitInfo.UnitName:=NewUnitName;
@ -2774,8 +2783,10 @@ writeln('*** HasResources=',ActiveUnitInfo.HasResources);
{$IFDEF IDE_MEM_CHECK}
CheckHeap(IntToStr(GetMem_Cnt));
{$ENDIF}
if ResourceCode<>nil then begin
if (ResourceCode<>nil) or (ActiveUnitInfo.Form<>nil) then begin
// save lrs - lazarus resource file and lfm - lazarus form text file
// Note: When there is a bug in the source, no resource code can be found,
// but the LFM file should always be saved
if (ActiveUnitInfo.Form<>nil) then begin
// stream component to resource code and to lfm file
@ -2810,38 +2821,47 @@ CheckHeap(IntToStr(GetMem_Cnt));
until Result<>mrRetry;
// create lazarus form resource code
if FormSavingOk then begin
MemStream:=TMemoryStream.Create;
try
BinCompStream.Position:=0;
BinaryToLazarusResourceCode(BinCompStream,MemStream
,'T'+ActiveUnitInfo.FormName,'FORMDATA');
MemStream.Position:=0;
SetLength(CompResourceCode,MemStream.Size);
MemStream.Read(CompResourceCode[1],length(CompResourceCode));
finally
MemStream.Free;
end;
if ResourceCode<>nil then begin
// there is no bug in the source, so the resource code should be
// changed too
MemStream:=TMemoryStream.Create;
try
BinCompStream.Position:=0;
BinaryToLazarusResourceCode(BinCompStream,MemStream
,'T'+ActiveUnitInfo.FormName,'FORMDATA');
MemStream.Position:=0;
SetLength(CompResourceCode,MemStream.Size);
MemStream.Read(CompResourceCode[1],length(CompResourceCode));
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
begin
ACaption:='Resource error';
AText:='Unable to add resource '
+'T'+ActiveUnitInfo.FormName+':FORMDATA to resource file '#13
+'"'+ResourceCode.FileName+'".'#13
+'Probably a syntax error.';
Result:=MessageDlg(ACaption, AText, mterror, [mbok, mbcancel], 0);
if Result=mrCancel then Result:=mrAbort;
exit;
// replace lazarus form resource code
if (not CodeToolBoss.AddLazarusResource(ResourceCode,
'T'+ActiveUnitInfo.FormName,CompResourceCode)) then
begin
ACaption:='Resource error';
AText:='Unable to add resource '
+'T'+ActiveUnitInfo.FormName+':FORMDATA to resource file '#13
+'"'+ResourceCode.FileName+'".'#13
+'Probably a syntax error.';
Result:=MessageDlg(ACaption, AText, mterror, [mbok, mbcancel], 0);
if Result=mrCancel then Result:=mrAbort;
exit;
end;
end;
if (not SaveToTestDir) then begin
// save lfm file
LFMFilename:=ChangeFileExt(ActiveUnitInfo.Filename,'.lfm');
if LFMCode=nil then begin
LFMCode:=CodeToolBoss.CreateFile(
ChangeFileExt(ResourceCode.Filename,'.lfm'));
LFMCode:=CodeToolBoss.CreateFile(LFMFilename);
if LFMCode=nil then begin
MessageDlg('Unable to create file',
'Unable to create file "'+LFMFilename+'"',
mtWarning,[mbIgnore,mbCancel],0);
end;
end;
if LFMCode<>nil then begin
{$IFDEF IDE_DEBUG}
@ -2950,8 +2970,11 @@ writeln('TMainIDE.DoCloseEditorUnit A PageIndex=',PageIndex);
end;
Result:=mrOk;
end;
// close form
if ActiveUnitInfo.Form<>nil then begin
if FLastFormActivated=ActiveUnitInfo.Form then
FLastFormActivated:=nil;
for i:=TWinControl(ActiveUnitInfo.Form).ComponentCount-1 downto 0 do
TheControlSelection.Remove(
TWinControl(ActiveUnitInfo.Form).Components[i]);
@ -2961,8 +2984,10 @@ writeln('TMainIDE.DoCloseEditorUnit A PageIndex=',PageIndex);
OldDesigner.Free;
ActiveUnitInfo.Form:=nil;
end;
// close source editor
SourceNoteBook.CloseFile(PageIndex);
// close project file (not remove)
Project.CloseEditorIndex(ActiveUnitInfo.EditorIndex);
ActiveUnitInfo.Loaded:=false;
@ -2977,7 +3002,7 @@ end;
function TMainIDE.DoOpenEditorFile(const AFileName:string;
ProjectLoading, OnlyIfExists:boolean):TModalResult;
var Ext,ACaption,AText:string;
i,BookmarkID:integer;
i,BookmarkID, LinkIndex:integer;
ReOpen, FormLoadingOk:boolean;
NewUnitInfo:TUnitInfo;
NewPageName, NewProgramName, LFMFilename: string;
@ -3145,27 +3170,25 @@ writeln('[TMainIDE.DoOpenEditorFile] B');
writeln('[TMainIDE.DoOpenEditorFile] C');
{$ENDIF}
NewUnitInfo.Loaded:=true;
Ext:=ExtractFileExt(NewUnitInfo.Filename);
// read form data
if (NewUnitInfo.Unitname<>'') then begin
if (NewUnitInfo.Unitname<>'') and ((Ext='.pas') or (Ext='.pp')) then begin
// this is a unit -> try to find the lfm file
FormLoadingOk:=true;
LFMFilename:=ChangeFileExt(NewUnitInfo.Filename,'.lfm');
{$IFDEF IDE_DEBUG}
writeln('TMainIDE.DoSaveEditorUnit B2 ',ResourceCode<>nil);
{$ENDIF}
LFMFilename:='';
NewBuf:=nil;
if FileExists(LFMFilename) then begin
Result:=DoLoadCodeBuffer(NewBuf,LFMFilename,true,false,true);
if Result<>mrOk then exit;
Result:=mrCancel;
end else begin
i:=-1;
NewBuf:=CodeToolBoss.FindNextResourceFile(NewUnitInfo.Source,i);
if NewBuf<>nil then begin
LFMFilename:=ChangeFileExt(NewBuf.Filename,'.lfm');
NewBuf:=nil;
if FileExists(LFMFilename) then begin
Result:=DoLoadCodeBuffer(NewBuf,LFMFilename,true,false,true);
if Result<>mrOk then exit;
Result:=mrCancel;
end;
LinkIndex:=-1;
NewBuf:=CodeToolBoss.FindNextResourceFile(NewUnitInfo.Source,LinkIndex);
if NewBuf<>nil then begin
LFMFilename:=ChangeFileExt(NewBuf.Filename,'.lfm');
NewBuf:=nil;
if FileExists(LFMFilename) then begin
Result:=DoLoadCodeBuffer(NewBuf,LFMFilename,true,false,true);
if Result<>mrOk then exit;
Result:=mrCancel;
end;
end;
@ -3231,9 +3254,10 @@ writeln('[TMainIDE.DoOpenEditorFile] C');
// select the new form (object inspector, formeditor, control selection)
if not ProjectLoading then begin
PropertyEditorHook1.LookupRoot := TForm(CInterface.Control);
PropertyEditorHook1.LookupRoot := TempForm;
TDesigner(TempForm.Designer).SelectOnlyThisComponent(TempForm);
end;
FLastFormActivated:=TempForm;
end;
end;
{$IFDEF IDE_DEBUG}
@ -3640,9 +3664,21 @@ writeln('AnUnitInfo.Filename=',AnUnitInfo.Filename);
end else begin
NewFilename:=ExpandFilename(SaveDialog.Filename);
EnvironmentOptions.LastOpenDialogDir:=ExtractFilePath(NewFilename);
if ExtractFileExt(NewFilename)='' then
Ext:=ExtractFileExt(NewFilename);
if Ext='' then begin
NewFilename:=NewFilename+'.lpi';
Ext:='.lpi';
end;
NewProgramName:=ExtractFileNameOnly(NewFilename);
if (Ext='.pas') or (Ext='.pp') then begin
if not IsValidIdent(NewProgramName) then begin
Result:=MessageDlg('Invalid Pascal Identifier',
'The name "'+NewProgramName+'" is not a valid pascal identifier.'
,mtWarning,[mbIgnore,mbCancel],0);
if Result=mrCancel then exit;
Result:=mrCancel;
end;
end;
if EnvironmentOptions.PascalFileLowerCase then
NewFileName:=ExtractFilePath(NewFilename)
+lowercase(ExtractFileName(NewFilename));
@ -3921,12 +3957,22 @@ CheckHeap(IntToStr(GetMem_Cnt));
end;
until LowestEditorIndex<0;
Result:=mrCancel;
//writeln('TMainIDE.DoOpenProjectFile D');
{$IFDEF IDE_DEBUG}
writeln('TMainIDE.DoOpenProjectFile D');
{$ENDIF}
// set active editor source editor
if (SourceNoteBook.NoteBook<>nil) and (Project.ActiveEditorIndexAtStart>=0)
and (Project.ActiveEditorIndexAtStart<SourceNoteBook.NoteBook.Pages.Count)
then
SourceNoteBook.Notebook.PageIndex:=Project.ActiveEditorIndexAtStart;
// select a form (object inspector, formeditor, control selection)
if FLastFormActivated<>nil then begin
PropertyEditorHook1.LookupRoot := FLastFormActivated;
TDesigner(FLastFormActivated.Designer).SelectOnlyThisComponent(
FLastFormActivated);
end;
// set all modified to false
for i:=0 to Project.UnitCount-1 do begin
@ -4846,6 +4892,11 @@ begin
end;
if AForm<>nil then begin
BringWindowToTop(AForm.Handle);
if FLastFormActivated=AForm then begin
// select the new form (object inspector, formeditor, control selection)
PropertyEditorHook1.LookupRoot := AForm;
TDesigner(AForm.Designer).SelectOnlyThisComponent(AForm);
end;
end;
end;
@ -6085,7 +6136,7 @@ begin
if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,true) then exit;
{$IFDEF IDE_DEBUG}
writeln('');
writeln('[TMainIDE.OnPropHookMethodExists] ************');
writeln('[TMainIDE.OnPropHookMethodExists] ************ ',AMethodName);
{$ENDIF}
Result:=CodeToolBoss.PublishedMethodExists(ActiveUnitInfo.Source,
ActiveUnitInfo.Form.ClassName,AMethodName,TypeData,
@ -6104,19 +6155,19 @@ begin
Result.Code:=nil;
Result.Data:=nil;
if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,true) then exit;
{ $IFDEF IDE_DEBUG}
{$IFDEF IDE_DEBUG}
writeln('');
writeln('[TMainIDE.OnPropHookCreateMethod] ************');
{ $ENDIF}
writeln('[TMainIDE.OnPropHookCreateMethod] ************ ',AMethodName);
{$ENDIF}
FOpenEditorsOnCodeToolChange:=true;
try
// create published method
r:=CodeToolBoss.CreatePublishedMethod(ActiveUnitInfo.Source,
ActiveUnitInfo.Form.ClassName,AMethodName,ATypeInfo);
{ $IFDEF IDE_DEBUG}
{$IFDEF IDE_DEBUG}
writeln('');
writeln('[TMainIDE.OnPropHookCreateMethod] ************2 ',r);
{ $ENDIF}
writeln('[TMainIDE.OnPropHookCreateMethod] ************2 ',r,' ',AMethodName);
{$ENDIF}
ApplyCodeToolChanges;
if r then begin
Result:=FormEditor1.JITFormList.CreateNewMethod(TForm(ActiveUnitInfo.Form)
@ -6387,6 +6438,9 @@ end.
{ =============================================================================
$Log$
Revision 1.249 2002/03/22 12:36:44 lazarus
MG: many fixes, to make it short: events
Revision 1.248 2002/03/21 23:15:39 lazarus
MG: fixes for save-project-as and pagenames

11
ide/project.pp
View File

@ -77,11 +77,11 @@ type
fTopLine: integer;
fUnitName: String;
function GetHasResources:boolean;
procedure SetUnitName(const NewUnitName:string);
function GetFileName: string;
function GetHasResources:boolean;
procedure SetReadOnly(const NewValue: boolean);
procedure SetSource(ABuffer: TCodeBuffer);
procedure SetUnitName(const NewUnitName:string);
public
constructor Create(ACodeBuffer: TCodeBuffer);
destructor Destroy; override;
@ -568,7 +568,7 @@ begin
+LE
+'initialization'+LE);
NewSource:=NewSource
+' {$I '+ResourceFilename+'}'+LE);
+' {$I '+ResourceFilename+'}'+LE;
end;
end;
NewSource:=NewSource+Beautified(
@ -596,7 +596,7 @@ function TUnitInfo.GetHasResources:boolean;
begin
Result:=fHasResources or (FormName<>'');
end;
{------------------------------------------------------------------------------
TProject Class
@ -1329,6 +1329,9 @@ end.
{
$Log$
Revision 1.54 2002/03/22 12:36:45 lazarus
MG: many fixes, to make it short: events
Revision 1.53 2002/03/21 23:59:59 lazarus
MG: code creation options applied to new unit source