diff --git a/.gitattributes b/.gitattributes
index adabcf3754..6f120402ad 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -60,6 +60,8 @@ components/codetools/customcodetool.pas svneol=native#text/pascal
components/codetools/definetemplates.pas svneol=native#text/pascal
components/codetools/directorycacher.pas svneol=native#text/plain
components/codetools/eventcodetool.pas svneol=native#text/pascal
+components/codetools/examples/addeventmethod.lpi svneol=native#text/plain
+components/codetools/examples/addeventmethod.lpr svneol=native#text/plain
components/codetools/examples/addmethod.lpi svneol=native#text/plain
components/codetools/examples/addmethod.lpr svneol=native#text/plain
components/codetools/examples/codecompletion.lpi svneol=native#text/plain
@@ -73,6 +75,7 @@ components/codetools/examples/getcontext.lpr svneol=native#text/plain
components/codetools/examples/methodjumping.lpi svneol=native#text/plain
components/codetools/examples/methodjumping.pas svneol=native#text/plain
components/codetools/examples/scanexamples/BigLettersUnit.pas svneol=native#text/plain
+components/codetools/examples/scanexamples/addeventexample.pas svneol=native#text/plain
components/codetools/examples/scanexamples/brokenfilenames.pas svneol=native#text/plain
components/codetools/examples/scanexamples/brokenincfiles.inc svneol=native#text/plain
components/codetools/examples/scanexamples/completion1.pas svneol=native#text/plain
diff --git a/components/codetools/codecompletiontool.pas b/components/codetools/codecompletiontool.pas
index 77c4a71710..09a389b018 100644
--- a/components/codetools/codecompletiontool.pas
+++ b/components/codetools/codecompletiontool.pas
@@ -123,7 +123,8 @@ type
JumpToProcName: string;
NewClassSectionIndent: array[TPascalClassSection] of integer;
NewClassSectionInsertPos: array[TPascalClassSection] of integer;
- FullTopLvlName: string;
+ fFullTopLvlName: string;// used by OnTopLvlIdentifierFound
+ fNewMainUsesSectionUnits: TAVLTree; // tree of PChar
procedure AddNewPropertyAccessMethodsToClassProcs(ClassProcs: TAVLTree;
const TheClassName: string);
procedure CheckForOverrideAndAddInheritedCode(ClassProcs: TAVLTree);
@@ -137,6 +138,7 @@ type
procedure InsertNewClassParts(PartType: TNewClassPart);
function InsertAllNewClassParts: boolean;
function InsertClassHeaderComment: boolean;
+ function InsertAllNewUnitsToMainUsesSection: boolean;
function CreateMissingProcBodies: boolean;
function NodeExtIsVariable(ANodeExt: TCodeTreeNodeExtension): boolean;
function NodeExtHasVisibilty(ANodeExt: TCodeTreeNodeExtension;
@@ -159,6 +161,7 @@ type
const VariableName, NewType: string;
out NewPos: TCodeXYPosition; out NewTopLine: integer;
SourceChangeCache: TSourceChangeCache): boolean;
+ procedure AddNeededUnitToMainUsesSection(AnUnitName: PChar);
function CompleteLocalVariableAssignment(CleanCursorPos,
OldTopLine: integer; CursorNode: TCodeTreeNode;
var NewPos: TCodeXYPosition; var NewTopLine: integer;
@@ -275,7 +278,7 @@ begin
TrimmedIdentifier:=GetIdentifier(Params.Identifier);
end;
end;
- FullTopLvlName:=FullTopLvlName+TrimmedIdentifier;
+ fFullTopLvlName:=fFullTopLvlName+TrimmedIdentifier;
Result:=ifrSuccess;
end;
@@ -378,6 +381,7 @@ begin
FirstInsert:=FirstInsert.Next;
NodeExtMemManager.DisposeNode(ANodeExt);
end;
+ FreeAndNil(fNewMainUsesSectionUnits);
end;
function TCodeCompletionCodeTool.NodeExtIsVariable(
@@ -801,6 +805,17 @@ begin
RaiseException('CompleteLocalVariableAssignment Internal error: AddLocalVariable');
end;
+procedure TCodeCompletionCodeTool.AddNeededUnitToMainUsesSection(
+ AnUnitName: PChar);
+begin
+ if fNewMainUsesSectionUnits=nil then
+ fNewMainUsesSectionUnits:=
+ TAVLTree.Create(TListSortCompare(@CompareIdentifiers));
+ //DebugLn(['TCodeCompletionCodeTool.AddNeededUnitToMainUsesSection AnUnitName="',AnUnitName,'"']);
+ if fNewMainUsesSectionUnits.Find(AnUnitName)<>nil then exit;
+ fNewMainUsesSectionUnits.Add(AnUnitName);
+end;
+
function TCodeCompletionCodeTool.CompleteLocalVariableAssignment(
CleanCursorPos, OldTopLine: integer;
CursorNode: TCodeTreeNode;
@@ -1949,6 +1964,81 @@ begin
InsertPos,InsertPos,Code);
end;
+function TCodeCompletionCodeTool.InsertAllNewUnitsToMainUsesSection: boolean;
+var
+ UsesNode: TCodeTreeNode;
+ AVLNode: TAVLTreeNode;
+ CurSourceName: String;
+ SectionNode: TCodeTreeNode;
+ NewUsesTerm: String;
+ NewUnitName: String;
+ InsertPos: LongInt;
+begin
+ Result:=true;
+ if (fNewMainUsesSectionUnits=nil) then exit;
+ //DebugLn(['TCodeCompletionCodeTool.InsertAllNewUnitsToMainUsesSection ']);
+ UsesNode:=FindMainUsesSection;
+
+ // remove units, that are already in the uses section
+ CurSourceName:=GetSourceName(false);
+ fNewMainUsesSectionUnits.Remove(PChar(CurSourceName)); // the unit itself
+ if UsesNode<>nil then begin
+ MoveCursorToNodeStart(UsesNode);
+ ReadNextAtom; // read 'uses'
+ repeat
+ ReadNextAtom; // read name
+ if AtomIsChar(';') then break;
+ fNewMainUsesSectionUnits.Remove(@Src[CurPos.StartPos]);
+ ReadNextAtom;
+ if UpAtomIs('IN') then begin
+ ReadNextAtom;
+ ReadNextAtom;
+ end;
+ if AtomIsChar(';') then break;
+ if not AtomIsChar(',') then break;
+ until (CurPos.StartPos>SrcLen);;
+
+ if (fNewMainUsesSectionUnits.Count=0) then exit;
+ end;
+
+ // add units
+ NewUsesTerm:='';
+ AVLNode:=fNewMainUsesSectionUnits.FindLowest;
+ while AVLNode<>nil do begin
+ if NewUsesTerm<>'' then
+ NewUsesTerm:=NewUsesTerm+', ';
+ NewUnitName:=GetIdentifier(PChar(AVLNode.Data));
+ NewUsesTerm:=NewUsesTerm+NewUnitName;
+ AVLNode:=fNewMainUsesSectionUnits.FindSuccessor(AVLNode);
+ end;
+ if UsesNode<>nil then begin
+ // add unit to existing uses section
+ MoveCursorToNodeStart(UsesNode); // for nice error position
+ InsertPos:=UsesNode.EndPos-1; // position of semicolon at end of uses section
+ NewUsesTerm:=', '+NewUsesTerm;
+ if not ASourceChangeCache.Replace(gtNone,gtNone,InsertPos,InsertPos,
+ NewUsesTerm) then exit;
+ end else begin
+ // create a new uses section
+ if Tree.Root=nil then exit;
+ SectionNode:=Tree.Root;
+ MoveCursorToNodeStart(SectionNode);
+ ReadNextAtom;
+ if UpAtomIs('UNIT') then begin
+ // search interface
+ SectionNode:=SectionNode.NextBrother;
+ if (SectionNode=nil) or (SectionNode.Desc<>ctnInterface) then exit;
+ MoveCursorToNodeStart(SectionNode);
+ ReadNextAtom;
+ end;
+ InsertPos:=CurPos.EndPos;
+ NewUsesTerm:=ASourceChangeCache.BeautifyCodeOptions.BeautifyKeyWord('uses')
+ +' '+NewUsesTerm+';';
+ if not ASourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,
+ InsertPos,InsertPos,NewUsesTerm) then exit;
+ end;
+end;
+
procedure TCodeCompletionCodeTool.AddNewPropertyAccessMethodsToClassProcs(
ClassProcs: TAVLTree; const TheClassName: string);
var ANodeExt: TCodeTreeNodeExtension;
@@ -2702,7 +2792,7 @@ var CleanCursorPos, Indent, insertPos: integer;
Params.ContextNode:=CursorNode;
MoveCursorToCleanPos(PropertyAtom.StartPos);
Params.SetIdentifier(Self,@Src[CurPos.StartPos],nil);
- FullTopLvlName:='';
+ fFullTopLvlName:='';
Params.OnTopLvlIdentifierFound:=@OnTopLvlIdentifierFound;
Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,
fdfTopLvlResolving,fdfFindVariable];
@@ -2736,7 +2826,7 @@ var CleanCursorPos, Indent, insertPos: integer;
l: integer;
begin
if UserEventAtom.StartPos=UserEventAtom.EndPos then begin
- Result:=FullTopLvlName;
+ Result:=fFullTopLvlName;
l:=PropertyAtom.EndPos-PropertyAtom.StartPos;
PropertyName:=copy(Src,PropertyAtom.StartPos,l);
if AnsiCompareText(PropertyName,RightStr(Result,l))<>0 then
diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas
index 3612a6dced..cac4d785b6 100644
--- a/components/codetools/codetoolmanager.pas
+++ b/components/codetools/codetoolmanager.pas
@@ -558,12 +558,14 @@ type
NewMethodName: string): boolean;
function CreatePublishedMethod(Code: TCodeBuffer; const AClassName,
NewMethodName: string; ATypeInfo: PTypeInfo;
- UseTypeInfoForParameters: boolean = false): boolean;
+ UseTypeInfoForParameters: boolean = false;
+ const ATypeUnitName: string = ''): boolean;
// private class parts
function CreatePrivateMethod(Code: TCodeBuffer; const AClassName,
NewMethodName: string; ATypeInfo: PTypeInfo;
- UseTypeInfoForParameters: boolean = false): boolean;
+ UseTypeInfoForParameters: boolean = false;
+ const ATypeUnitName: string = ''): boolean;
// IDE % directives
function GetIDEDirectives(Code: TCodeBuffer;
@@ -2521,7 +2523,7 @@ end;
function TCodeToolManager.CreatePublishedMethod(Code: TCodeBuffer;
const AClassName, NewMethodName: string; ATypeInfo: PTypeInfo;
- UseTypeInfoForParameters: boolean): boolean;
+ UseTypeInfoForParameters: boolean; const ATypeUnitName: string): boolean;
begin
{$IFDEF CTDEBUG}
DebugLn('TCodeToolManager.CreatePublishedMethod A');
@@ -2531,8 +2533,8 @@ begin
try
SourceChangeCache.Clear;
Result:=FCurCodeTool.CreateMethod(UpperCaseStr(AClassName),
- NewMethodName,ATypeInfo,SourceChangeCache,UseTypeInfoForParameters,
- pcsPublished);
+ NewMethodName,ATypeInfo,ATypeUnitName,SourceChangeCache,
+ UseTypeInfoForParameters,pcsPublished);
except
on e: Exception do Result:=HandleException(e);
end;
@@ -2540,7 +2542,7 @@ end;
function TCodeToolManager.CreatePrivateMethod(Code: TCodeBuffer;
const AClassName, NewMethodName: string; ATypeInfo: PTypeInfo;
- UseTypeInfoForParameters: boolean): boolean;
+ UseTypeInfoForParameters: boolean; const ATypeUnitName: string): boolean;
begin
{$IFDEF CTDEBUG}
DebugLn('TCodeToolManager.CreatePrivateMethod A');
@@ -2550,8 +2552,8 @@ begin
try
SourceChangeCache.Clear;
Result:=FCurCodeTool.CreateMethod(UpperCaseStr(AClassName),
- NewMethodName,ATypeInfo,SourceChangeCache,UseTypeInfoForParameters,
- pcsPrivate);
+ NewMethodName,ATypeInfo,ATypeUnitName,SourceChangeCache,
+ UseTypeInfoForParameters,pcsPrivate);
except
on e: Exception do Result:=HandleException(e);
end;
diff --git a/components/codetools/codetoolsconfig.pas b/components/codetools/codetoolsconfig.pas
index 44fded228f..f62f6c12c7 100644
--- a/components/codetools/codetoolsconfig.pas
+++ b/components/codetools/codetoolsconfig.pas
@@ -98,7 +98,7 @@ type
property Modified: boolean read FModified write SetModified;
// FPC
- property FPCSrcDir: string read FFPCSrcDir write SetFPCSrcDir; // e.g. /usr/shar/fpcsrc
+ property FPCSrcDir: string read FFPCSrcDir write SetFPCSrcDir; // e.g. /usr/share/fpcsrc
property FPCPath: string read FFPCPath write SetFPCPath; // e.g. /usr/bin/ppc386
property FPCOptions: string read FFPCOptions write SetFPCOptions;
property TargetOS: string read FTargetOS write SetTargetOS;
diff --git a/components/codetools/codetoolsstrconsts.pas b/components/codetools/codetoolsstrconsts.pas
index a1892ed68a..503b0cf54c 100644
--- a/components/codetools/codetoolsstrconsts.pas
+++ b/components/codetools/codetoolsstrconsts.pas
@@ -148,6 +148,7 @@ ResourceString
ctsUnableToCompleteProperty = 'unable to complete property';
ctsErrorDuringInsertingNewClassParts = 'error during inserting new class parts';
ctsErrorDuringCreationOfNewProcBodies = 'error during creation of new proc bodies';
+ ctsErrorDuringInsertingNewUsesSection = 'error during inserting new units to the main uses section';
ctsUnableToApplyChanges = 'unable to apply changes';
ctsEndOfSourceNotFound = 'End of source not found';
ctsCursorPosOutsideOfCode = 'cursor pos outside of code';
diff --git a/components/codetools/codetoolsstructs.pas b/components/codetools/codetoolsstructs.pas
index c027fd864d..09b0a1b662 100644
--- a/components/codetools/codetoolsstructs.pas
+++ b/components/codetools/codetoolsstructs.pas
@@ -121,6 +121,7 @@ function CompareStringToStringItemsI(Data1, Data2: Pointer): integer;
function CompareStringAndStringToStringTreeItem(Key, Data: Pointer): integer;
function CompareStringAndStringToStringTreeItemI(Key, Data: Pointer): integer;
+
implementation
function CompareStringToStringItems(Data1, Data2: Pointer): integer;
diff --git a/components/codetools/eventcodetool.pas b/components/codetools/eventcodetool.pas
index 7b33f26cbb..535d6db2e9 100644
--- a/components/codetools/eventcodetool.pas
+++ b/components/codetools/eventcodetool.pas
@@ -86,12 +86,13 @@ type
SourceChangeCache: TSourceChangeCache): boolean;
function CreateMethod(const UpperClassName,
- AMethodName: string; ATypeInfo: PTypeInfo;
+ AMethodName: string; ATypeInfo: PTypeInfo; const ATypeUnitName: string;
SourceChangeCache: TSourceChangeCache;
UseTypeInfoForParameters: boolean = false;
Section: TPascalClassSection = pcsPublished): boolean;
function CreateMethod(ClassNode: TCodeTreeNode;
- const AMethodName: string; ATypeInfo: PTypeInfo;
+ const AMethodName: string;
+ ATypeInfo: PTypeInfo; const ATypeUnitName: string;
SourceChangeCache: TSourceChangeCache;
UseTypeInfoForParameters: boolean = false;
Section: TPascalClassSection = pcsPublished): boolean;
@@ -102,7 +103,8 @@ type
const UpperMethodName: string): TFindContext;
function FindMethodNodeInImplementation(const UpperClassName,
UpperMethodName: string; BuildTreeBefore: boolean): TCodeTreeNode;
- function FindMethodTypeInfo(ATypeInfo: PTypeInfo): TFindContext;
+ function FindMethodTypeInfo(ATypeInfo: PTypeInfo;
+ const AStartUnitName: string = ''): TFindContext;
function MethodTypeDataToStr(TypeData: PTypeData;
Attr: TProcHeadAttributes): string;
end;
@@ -357,12 +359,32 @@ begin
end;
end;
-function TEventsCodeTool.FindMethodTypeInfo(ATypeInfo: PTypeInfo): TFindContext;
+function TEventsCodeTool.FindMethodTypeInfo(ATypeInfo: PTypeInfo;
+ const AStartUnitName: string): TFindContext;
+var
+ Tool: TFindDeclarationTool;
+
+ procedure RaiseTypeNotFound;
+ begin
+ RaiseException('type '+ATypeInfo^.Name+' not found, because tool is '+dbgsname(Tool));
+ end;
+
var TypeName: string;
Params: TFindDeclarationParams;
begin
+ if AStartUnitName<>'' then begin
+ // start searching in another unit
+ Tool:=FindCodeToolForUsedUnit(AStartUnitName,'',true);
+ if not (Tool is TEventsCodeTool) then
+ RaiseTypeNotFound;
+ TEventsCodeTool(Tool).BuildTree(true);
+ Result:=TEventsCodeTool(Tool).FindMethodTypeInfo(ATypeInfo,'');
+ exit;
+ end;
+
ActivateGlobalWriteLock;
try
+
// find method type declaration
TypeName:=ATypeInfo^.Name;
CheckDependsOnNodeCaches;
@@ -574,7 +596,7 @@ begin
end;
function TEventsCodeTool.CreateMethod(const UpperClassName,
- AMethodName: string; ATypeInfo: PTypeInfo;
+ AMethodName: string; ATypeInfo: PTypeInfo; const ATypeUnitName: string;
SourceChangeCache: TSourceChangeCache;
UseTypeInfoForParameters: boolean;
Section: TPascalClassSection): boolean;
@@ -584,22 +606,33 @@ begin
BuildTree(false);
if not EndOfSourceFound then exit;
AClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
- Result:=CreateMethod(AClassNode,AMethodName,ATypeInfo,
+ Result:=CreateMethod(AClassNode,AMethodName,ATypeInfo,ATypeUnitName,
SourceChangeCache,UseTypeInfoForParameters,Section);
end;
function TEventsCodeTool.CreateMethod(ClassNode: TCodeTreeNode;
- const AMethodName: string; ATypeInfo: PTypeInfo;
+ const AMethodName: string; ATypeInfo: PTypeInfo; const ATypeUnitName: string;
SourceChangeCache: TSourceChangeCache; UseTypeInfoForParameters: boolean;
Section: TPascalClassSection): boolean;
+
+ procedure AddNeededUnits(const AFindContext: TFindContext);
+ var
+ MethodUnitName: String;
+ begin
+ MethodUnitName:=AFindContext.Tool.GetSourceName(false);
+ AddNeededUnitToMainUsesSection(PChar(MethodUnitName));
+ // ToDo
+ // search every parameter type and collect units
+ end;
+
var
CleanMethodDefinition, MethodDefinition: string;
FindContext: TFindContext;
ATypeData: PTypeData;
NewSection: TNewClassPart;
begin
+ Result:=false;
try
- Result:=false;
if (ClassNode=nil) or (ClassNode.Desc<>ctnClass) or (AMethodName='')
or (ATypeInfo=nil) or (SourceChangeCache=nil) or (Scanner=nil) then exit;
{$IFDEF CTDEBUG}
@@ -611,7 +644,6 @@ begin
// check if method definition already exists in class
if UseTypeInfoForParameters then begin
// do not lookup the declaration in the source
-
ATypeData:=GetTypeData(ATypeInfo);
if ATypeData=nil then exit(false);
CleanMethodDefinition:=UpperCaseStr(AMethodName)
@@ -619,7 +651,8 @@ begin
[phpWithoutClassName, phpWithoutName, phpInUpperCase]);
end else begin
// search typeinfo in source
- FindContext:=FindMethodTypeInfo(ATypeInfo);
+ FindContext:=FindMethodTypeInfo(ATypeInfo,ATypeUnitName);
+ AddNeededUnits(FindContext);
CleanMethodDefinition:=UpperCaseStr(AMethodName)
+FindContext.Tool.ExtractProcHead(FindContext.Node,
[phpWithoutClassName, phpWithoutName, phpInUpperCase]);
@@ -658,10 +691,10 @@ begin
{$ENDIF}
if not InsertAllNewClassParts then
RaiseException(ctsErrorDuringInsertingNewClassParts);
-
- // insert all missing proc bodies
if not CreateMissingProcBodies then
RaiseException(ctsErrorDuringCreationOfNewProcBodies);
+ if not InsertAllNewUnitsToMainUsesSection then
+ RaiseException(ctsErrorDuringInsertingNewUsesSection);
// apply the changes
if not SourceChangeCache.Apply then
diff --git a/components/codetools/examples/addeventmethod.lpi b/components/codetools/examples/addeventmethod.lpi
new file mode 100644
index 0000000000..59ab2dec3c
--- /dev/null
+++ b/components/codetools/examples/addeventmethod.lpi
@@ -0,0 +1,59 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/codetools/examples/addeventmethod.lpr b/components/codetools/examples/addeventmethod.lpr
new file mode 100644
index 0000000000..4fb133d8f8
--- /dev/null
+++ b/components/codetools/examples/addeventmethod.lpr
@@ -0,0 +1,85 @@
+{
+ ***************************************************************************
+ * *
+ * This source is free software; you can redistribute it and/or modify *
+ * it under the terms of the GNU General Public License as published by *
+ * the Free Software Foundation; either version 2 of the License, or *
+ * (at your option) any later version. *
+ * *
+ * This code is distributed in the hope that it will be useful, but *
+ * WITHOUT ANY WARRANTY; without even the implied warranty of *
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
+ * General Public License for more details. *
+ * *
+ * A copy of the GNU General Public License is available on the World *
+ * Wide Web at . You can also *
+ * obtain it by writing to the Free Software Foundation, *
+ * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
+ * *
+ ***************************************************************************
+
+ Author: Mattias Gaertner
+
+ Abstract:
+ Demonstrating, how to add a method to a class and extending the uses section.
+}
+program AddEventMethod;
+
+{$mode objfpc}{$H+}
+
+uses
+ Classes, SysUtils, CodeCache, CodeToolManager, SimpleUnit1, FileProcs,
+ CodeToolsConfig, CodeCompletionTool, ExtCtrls;
+
+const
+ ConfigFilename = 'codetools.config';
+var
+ Options: TCodeToolsOptions;
+ Filename: string;
+ Code: TCodeBuffer;
+begin
+ // setup the Options
+ Options:=TCodeToolsOptions.Create;
+
+ // To not parse the FPC sources every time, the options are saved to a file.
+ if FileExists(ConfigFilename) then
+ Options.LoadFromFile(ConfigFilename);
+
+ // setup your paths
+ Options.FPCPath:='/usr/bin/ppc386';
+ Options.FPCSrcDir:=ExpandFileName('~/freepascal/fpc');
+ Options.LazarusSrcDir:=ExpandFileName('~/pascal/lazarus');
+
+ // optional: ProjectDir and TestPascalFile exists only to easily test some
+ // things.
+ Options.ProjectDir:=GetCurrentDir+'/scanexamples/';
+ Options.TestPascalFile:=Options.ProjectDir+'addeventexample.pas';
+
+ // init the codetools
+ if not Options.UnitLinkListValid then
+ writeln('Scanning FPC sources may take a while ...');
+ CodeToolBoss.Init(Options);
+
+ // save the options and the FPC unit links results.
+ Options.SaveToFile(ConfigFilename);
+
+ // load the file
+ Filename:=Options.TestPascalFile;
+ Code:=CodeToolBoss.LoadFile(Filename,false,false);
+ if Code=nil then
+ raise Exception.Create('loading failed '+Filename);
+
+ // Example 1: add a method compatible to TTabChangingEvent
+ // TTabChangingEvent is used in ComCtrls, but defined in ExtCtrls.
+ // The codetools will search TTabChangingEvent and will add ExtCtrls to the
+ // uses section.
+ if CodeToolBoss.CreatePublishedMethod(Code,'TForm1','NewMethod',
+ typeinfo(TTabChangingEvent),false,'ComCtrls') then
+ begin
+ writeln('Method added: ');
+ writeln(Code.Source);
+ end else begin
+ raise Exception.Create('Adding method failed');
+ end;
+end.
+
diff --git a/components/codetools/examples/addmethod.lpr b/components/codetools/examples/addmethod.lpr
index 115637262b..b985a6dcd9 100644
--- a/components/codetools/examples/addmethod.lpr
+++ b/components/codetools/examples/addmethod.lpr
@@ -82,7 +82,7 @@ begin
Tool.AddClassInsertion(CleanMethodDefinition, MethodDefinition, MethodName,
ncpPublishedProcs);
end;
-
+
if not Tool.ApplyClassCompletion then
raise Exception.Create('Explore failed');
writeln('Method added: ');
diff --git a/components/codetools/examples/scanexamples/addeventexample.pas b/components/codetools/examples/scanexamples/addeventexample.pas
new file mode 100644
index 0000000000..6996de3e9d
--- /dev/null
+++ b/components/codetools/examples/scanexamples/addeventexample.pas
@@ -0,0 +1,29 @@
+unit AddEventExample;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, Forms, Controls, ComCtrls;
+
+type
+ TForm1 = class(TForm)
+ PageControl1: TPageControl;
+ procedure Button1Click(Sender: TObject);
+ procedure CheckBox1Change(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure FormPaint(Sender: TObject);
+ private
+ public
+ MyBitmap: TBitmap;
+ end;
+
+ TMyComponent = class(TComponent)
+ end;
+
+implementation
+
+end.
+
diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas
index bcad648433..9e7c492ef7 100644
--- a/components/codetools/finddeclarationtool.pas
+++ b/components/codetools/finddeclarationtool.pas
@@ -617,6 +617,8 @@ type
function FindCodeToolForUsedUnit(UnitNameAtom,
UnitInFileAtom: TAtomPosition;
ExceptionOnNotFound: boolean): TFindDeclarationTool;
+ function FindCodeToolForUsedUnit(const AnUnitName, AnUnitInFilename: string;
+ ExceptionOnNotFound: boolean): TFindDeclarationTool;
function FindIdentifierInInterface(AskingTool: TFindDeclarationTool;
Params: TFindDeclarationParams): boolean;
function CompareNodeIdentifier(Node: TCodeTreeNode;
@@ -4301,7 +4303,6 @@ function TFindDeclarationTool.FindCodeToolForUsedUnit(UnitNameAtom,
UnitInFileAtom: TAtomPosition;
ExceptionOnNotFound: boolean): TFindDeclarationTool;
var AnUnitName, AnUnitInFilename: string;
- NewCode: TCodeBuffer;
begin
Result:=nil;
if (UnitNameAtom.StartPos<1) or (UnitNameAtom.EndPos<=UnitNameAtom.StartPos)
@@ -4320,6 +4321,15 @@ begin
UnitInFileAtom.EndPos-UnitInFileAtom.StartPos-2);
end else
AnUnitInFilename:='';
+ Result:=FindCodeToolForUsedUnit(AnUnitName,AnUnitInFilename,ExceptionOnNotFound);
+end;
+
+function TFindDeclarationTool.FindCodeToolForUsedUnit(const AnUnitName,
+ AnUnitInFilename: string; ExceptionOnNotFound: boolean): TFindDeclarationTool;
+var
+ NewCode: TCodeBuffer;
+begin
+ Result:=nil;
NewCode:=FindUnitSource(AnUnitName,AnUnitInFilename,ExceptionOnNotFound);
if (NewCode=nil) then begin
// no source found
diff --git a/ide/main.pp b/ide/main.pp
index e11f662e2e..8899d81077 100644
--- a/ide/main.pp
+++ b/ide/main.pp
@@ -361,7 +361,8 @@ type
var MethodIsCompatible, MethodIsPublished,
IdentIsMethod: boolean): boolean;
function OnPropHookCreateMethod(const AMethodName:ShortString;
- ATypeInfo:PTypeInfo): TMethod;
+ ATypeInfo:PTypeInfo;
+ const ATypeUnitName: string): TMethod;
procedure OnPropHookShowMethod(const AMethodName:ShortString);
procedure OnPropHookRenameMethod(const CurName, NewName:ShortString);
function OnPropHookBeforeAddPersistent(Sender: TObject;
@@ -12428,7 +12429,7 @@ begin
end;
function TMainIDE.OnPropHookCreateMethod(const AMethodName: ShortString;
- ATypeInfo: PTypeInfo): TMethod;
+ ATypeInfo: PTypeInfo; const ATypeUnitName: string): TMethod;
var ActiveSrcEdit: TSourceEditor;
ActiveUnitInfo: TUnitInfo;
r: boolean;
@@ -12445,7 +12446,8 @@ begin
try
// create published method
r:=CodeToolBoss.CreatePublishedMethod(ActiveUnitInfo.Source,
- ActiveUnitInfo.Component.ClassName,AMethodName,ATypeInfo);
+ ActiveUnitInfo.Component.ClassName,AMethodName,ATypeInfo,true,
+ ATypeUnitName);
{$IFDEF IDE_DEBUG}
writeln('');
writeln('[TMainIDE.OnPropHookCreateMethod] ************2 ',r,' ',AMethodName);
diff --git a/ide/todolist.pp b/ide/todolist.pp
index 241c8e9655..8ea86c8514 100644
--- a/ide/todolist.pp
+++ b/ide/todolist.pp
@@ -289,24 +289,27 @@ begin
end;
//Find in comment the ToDo message
-procedure TfrmTodo.ParseComment(const aFileName: string; const SComment, EComment: string;
+procedure TfrmTodo.ParseComment(const aFileName: string;
+ const SComment, EComment: string;
const TokenString: string; LineNumber: Integer);
Var
N,J : Integer;
ParsingString : string;
CListItem : TListItem;
TodoFlag : string;
+
function IsTodoFlag(const Flag: string): boolean;
begin
TodoFLag := Flag;
Result := Pos(UpperCase(Flag),UpperCase(TokenString)) > 1;
end;
+
begin
- if IsTodoFlag(cTodoFlag) or IsTodoFlag(cAltTodoFlag) then
+ if IsTodoFlag(cTodoFlag) or IsTodoFlag(cAltTodoFlag) then
begin
// We found a token that looks like a TODO comment. Now
// verify that it *is* one: either a white-space or the
- // comment token need to be right in front of the TODO item
+ // comment token need to be in front of the TODO item
// Remove comment characters
ParsingString := TokenString;
diff --git a/ideintf/propedits.pp b/ideintf/propedits.pp
index b63e6d45e9..d0ef86724e 100644
--- a/ideintf/propedits.pp
+++ b/ideintf/propedits.pp
@@ -297,7 +297,7 @@ type
function GetAttributes: TPropertyAttributes; virtual;
function IsReadOnly: boolean; virtual;
function GetComponent(Index: Integer): TPersistent;// for Delphi compatibility
- function GetUnitName(Index: Integer): string;
+ function GetUnitName(Index: Integer = 0): string;
function GetEditLimit: Integer; virtual;
function GetName: shortstring; virtual;
procedure GetProperties(Proc: TGetPropEditProc); virtual;
@@ -1096,7 +1096,7 @@ type
TPropHookChangeLookupRoot = procedure of object;
// methods
TPropHookCreateMethod = function(const Name:ShortString;
- ATypeInfo:PTypeInfo): TMethod of object;
+ ATypeInfo:PTypeInfo; const ATypeUnitName: string): TMethod of object;
TPropHookGetMethodName = function(const Method:TMethod): ShortString of object;
TPropHookGetMethods = procedure(TypeData:PTypeData; Proc:TGetStringProc) of object;
TPropHookMethodExists = function(const Name:ShortString; TypeData: PTypeData;
@@ -1190,7 +1190,8 @@ type
// lookup root
property LookupRoot: TPersistent read FLookupRoot write SetLookupRoot;
// methods
- function CreateMethod(const Name:ShortString; ATypeInfo:PTypeInfo): TMethod;
+ function CreateMethod(const Name:ShortString; ATypeInfo:PTypeInfo;
+ const ATypeUnitName: string): TMethod;
function GetMethodName(const Method:TMethod): ShortString;
procedure GetMethods(TypeData:PTypeData; Proc:TGetStringProc);
function MethodExists(const Name:ShortString; TypeData: PTypeData;
@@ -3848,7 +3849,7 @@ begin
//writeln('### TMethodPropertyEditor.SetValue E');
CreateNewMethod := IsValidIdent(NewValue) and not NewMethodExists;
//OldMethod := GetMethodValue;
- SetMethodValue(PropertyHook.CreateMethod(NewValue,GetPropType));
+ SetMethodValue(PropertyHook.CreateMethod(NewValue,GetPropType,GetUnitName));
//writeln('### TMethodPropertyEditor.SetValue F NewValue=',GetValue);
if CreateNewMethod then begin
{if (PropCount = 1) and (OldMethod.Data <> nil) and (OldMethod.Code <> nil)
@@ -4952,7 +4953,7 @@ end;
{ TPropertyEditorHook }
function TPropertyEditorHook.CreateMethod(const Name:Shortstring;
- ATypeInfo:PTypeInfo): TMethod;
+ ATypeInfo:PTypeInfo; const ATypeUnitName: string): TMethod;
var
i: Integer;
Handler: TPropHookCreateMethod;
@@ -4963,7 +4964,7 @@ begin
i:=GetHandlerCount(htCreateMethod);
while GetNextHandlerIndex(htCreateMethod,i) do begin
Handler:=TPropHookCreateMethod(FHandlers[htCreateMethod][i]);
- Result:=Handler(Name,ATypeInfo);
+ Result:=Handler(Name,ATypeInfo,ATypeUnitName);
if Result.Code<>nil then exit;
end;
end;
diff --git a/lcl/forms.pp b/lcl/forms.pp
index d0bfbf27e1..8dd1988aff 100644
--- a/lcl/forms.pp
+++ b/lcl/forms.pp
@@ -807,8 +807,6 @@ type
TOnUserInputEvent = procedure(Sender: TObject; Msg: Cardinal) of object;
TDataEvent = procedure (Data: PtrInt) of object;
- //TODO: move to LMessages ?
-
// application hint stuff
TCMHintShow = record
Msg: Cardinal;
@@ -1398,7 +1396,6 @@ function IsAccel(VK: word; const Str: string): Boolean;
var
lPos: integer;
begin
- // TODO: MBCS/UTF-8
lPos:=1;
while (lPos'&' then begin
diff --git a/packager/packageeditor.pas b/packager/packageeditor.pas
index a86853b2b4..7d6070d08e 100644
--- a/packager/packageeditor.pas
+++ b/packager/packageeditor.pas
@@ -42,8 +42,9 @@ uses
Graphics, LCLType, LCLProc, Menus, Dialogs, FileUtil,
HelpIntfs, AVL_Tree, Laz_XMLCfg, LazIDEIntf, ProjectIntf, FormEditingIntf,
IDEProcs, LazConf, LazarusIDEStrConsts, IDEOptionDefs, IDEDefs,
- CompilerOptions, CompilerOptionsDlg, ComponentReg, PackageDefs, PkgOptionsDlg,
- AddToPackageDlg, PkgVirtualUnitEditor, PackageSystem;
+ IDEContextHelpEdit, CompilerOptions, CompilerOptionsDlg, ComponentReg,
+ PackageDefs, PkgOptionsDlg, AddToPackageDlg, PkgVirtualUnitEditor,
+ PackageSystem;
type
TOnCreatePkgMakefile =
@@ -599,7 +600,7 @@ end;
procedure TPackageEditorForm.HelpBitBtnClick(Sender: TObject);
begin
- Application.ShowHelpForObjecct(HelpBitBtn)
+ ShowContextHelpForIDE(HelpBitBtn);
end;
procedure TPackageEditorForm.InstallBitBtnClick(Sender: TObject);
diff --git a/packager/pkgoptionsdlg.pas b/packager/pkgoptionsdlg.pas
index 69e8f16c3b..2679e77017 100644
--- a/packager/pkgoptionsdlg.pas
+++ b/packager/pkgoptionsdlg.pas
@@ -503,6 +503,7 @@ begin
Caption:=lisLazBuildOk;
Parent:=Self;
OnClick:=@OkButtonClick;
+ Default:=true;
end;
CancelButton:=TButton.Create(Self);
@@ -511,6 +512,7 @@ begin
Parent:=Self;
Caption:=dlgCancel;
ModalResult:=mrCancel;
+ Cancel:=true;
end;
end;