added package SimpleIDEIntf to test IDE plugins easier

git-svn-id: trunk@10372 -
This commit is contained in:
mattias 2007-01-04 19:51:33 +00:00
parent 410840847b
commit 787f9e814d
16 changed files with 1020 additions and 17 deletions

7
.gitattributes vendored
View File

@ -421,6 +421,13 @@ components/sdf/sdflaz.lpk svneol=native#text/pascal
components/sdf/sdflaz.pas svneol=native#text/pascal components/sdf/sdflaz.pas svneol=native#text/pascal
components/sdf/tfixedformatdataset.xpm -text svneol=native#image/x-xpixmap components/sdf/tfixedformatdataset.xpm -text svneol=native#image/x-xpixmap
components/sdf/tsdfdataset.xpm -text svneol=native#image/x-xpixmap components/sdf/tsdfdataset.xpm -text svneol=native#image/x-xpixmap
components/simpleideintf/README.txt svneol=native#text/plain
components/simpleideintf/examples/files/h2pastest.pas svneol=native#text/plain
components/simpleideintf/examples/testh2pastool.lpi svneol=native#text/plain
components/simpleideintf/examples/testh2pastool.lpr svneol=native#text/plain
components/simpleideintf/simpleide.pas svneol=native#text/plain
components/simpleideintf/simpleideintf.lpk svneol=native#text/plain
components/simpleideintf/simpleideintf.pas svneol=native#text/plain
components/sqldb/Makefile svneol=native#text/plain components/sqldb/Makefile svneol=native#text/plain
components/sqldb/Makefile.fpc svneol=native#text/plain components/sqldb/Makefile.fpc svneol=native#text/plain
components/sqldb/lib/README.txt svneol=native#text/plain components/sqldb/lib/README.txt svneol=native#text/plain

View File

@ -101,6 +101,8 @@ function FindFirstLineEndAfterInCode(const Source: string;
function ChompLineEndsAtEnd(const s: string): string; function ChompLineEndsAtEnd(const s: string): string;
function ChompOneLineEndAtEnd(const s: string): string; function ChompOneLineEndAtEnd(const s: string): string;
function TrimLineEnds(const s: string; TrimStart, TrimEnd: boolean): string; function TrimLineEnds(const s: string; TrimStart, TrimEnd: boolean): string;
function SrcPosToLineCol(const s: string; Position: integer;
out Line, Col: integer): boolean;
// brackets // brackets
function GetBracketLvl(const Src: string; StartPos, EndPos: integer; function GetBracketLvl(const Src: string; StartPos, EndPos: integer;
@ -270,7 +272,7 @@ function SearchCodeInSource(const Source, Find: string; StartPos:integer;
function ReadNextPascalAtom(const Source: string; function ReadNextPascalAtom(const Source: string;
var Position, AtomStart: integer): string; var Position, AtomStart: integer): string;
procedure ReadRawNextPascalAtom(const Source: string; procedure ReadRawNextPascalAtom(const Source: string;
var Position: integer; out AtomStart: integer); var Position: integer; var AtomStart: integer);
function ReadTilPascalBracketClose(const Source: string; function ReadTilPascalBracketClose(const Source: string;
var Position: integer): boolean; var Position: integer): boolean;
@ -406,6 +408,7 @@ begin
Result:=false; Result:=false;
repeat repeat
UsesStart:=SearchCodeInSource(Source,'uses',1,UsesEnd,false); UsesStart:=SearchCodeInSource(Source,'uses',1,UsesEnd,false);
if UsesEnd=0 then ;
if UsesStart>0 then begin if UsesStart>0 then begin
if IsUnitUsedInUsesSection(Source,UnitName,UsesStart) then begin if IsUnitUsedInUsesSection(Source,UnitName,UsesStart) then begin
Result:=true; Result:=true;
@ -743,6 +746,7 @@ begin
Position:=SearchCodeInSource(Source.Source,'application.run',1 Position:=SearchCodeInSource(Source.Source,'application.run',1
,EndPosition,false); ,EndPosition,false);
if Position<1 then exit; if Position<1 then exit;
if EndPosition=0 then ;
Source.Insert(Position, Source.Insert(Position,
'Application.CreateForm('+AClassName+','+AName+');'+LineEnding+' '); 'Application.CreateForm('+AClassName+','+AName+');'+LineEnding+' ');
Result:=true; Result:=true;
@ -771,11 +775,12 @@ begin
Position:=SearchCodeInSource(Source, Position:=SearchCodeInSource(Source,
'application.createform('+AClassName+','+AName+')',1,EndPosition,false); 'application.createform('+AClassName+','+AName+')',1,EndPosition,false);
Result:=Position>0; Result:=Position>0;
if EndPosition=0 then ;
end; end;
function ListAllCreateFormsInProgram(const Source:string):TStrings; function ListAllCreateFormsInProgram(const Source:string):TStrings;
// list format: <formname>:<formclassname> // list format: <formname>:<formclassname>
var Position,EndPosition:integer; var Position, EndPosition: integer;
s:string; s:string;
begin begin
Result:=TStringList.Create; Result:=TStringList.Create;
@ -1432,7 +1437,7 @@ begin
end; end;
procedure ReadRawNextPascalAtom(const Source: string; procedure ReadRawNextPascalAtom(const Source: string;
var Position: integer; out AtomStart: integer); var Position: integer; var AtomStart: integer);
var Len:integer; var Len:integer;
c1,c2:char; c1,c2:char;
begin begin
@ -2018,6 +2023,45 @@ begin
Result:=s; Result:=s;
end; end;
function SrcPosToLineCol(const s: string; Position: integer;
out Line, Col: integer): boolean;
var
p: LongInt;
l: Integer;
begin
if (Position<1) then begin
Line:=1;
Col:=1;
Result:=false;
exit;
end;
l:=length(s);
if l>Position then l:=Position;
Line:=1;
Col:=1;
p:=1;
while (p<l) do begin
case s[p] of
#10,#13:
begin
inc(p);
if (p<=length(s)) and (s[p] in [#10,#13]) and (s[p-1]<>s[p]) then
begin
if p=Position then exit(true);
inc(p);
end;
// new line
inc(Line);
Col:=1;
end;
else
inc(p);
inc(Col);
end;
end;
if p=Position then Result:=true;
end;
function GetBracketLvl(const Src: string; StartPos, EndPos: integer; function GetBracketLvl(const Src: string; StartPos, EndPos: integer;
NestedComments: boolean): integer; NestedComments: boolean): integer;
var var
@ -2837,6 +2881,7 @@ var
LengthOfLastLine: integer; LengthOfLastLine: integer;
begin begin
Result:=LineEndCount(Txt,LengthOfLastLine); Result:=LineEndCount(Txt,LengthOfLastLine);
if LengthOfLastLine=0 then ;
end; end;
function TrimCodeSpace(const ACode: string): string; function TrimCodeSpace(const ACode: string): string;

View File

@ -1950,8 +1950,6 @@ end;
function TCodeToolManager.ReplaceWord(Code: TCodeBuffer; const OldWord, function TCodeToolManager.ReplaceWord(Code: TCodeBuffer; const OldWord,
NewWord: string; ChangeStrings: boolean): boolean; NewWord: string; ChangeStrings: boolean): boolean;
var
CursorPos, SectionPos, NearestPos: TCodeXYPosition;
begin begin
Result:=false; Result:=false;
{$IFDEF CTDEBUG} {$IFDEF CTDEBUG}
@ -3431,6 +3429,7 @@ begin
try try
Result:=FCurCodeTool.FindApplicationTitleStatement(StartPos, Result:=FCurCodeTool.FindApplicationTitleStatement(StartPos,
StringConstStartPos,EndPos); StringConstStartPos,EndPos);
if StartPos=0 then ;
Result:=FCurCodeTool.GetApplicationTitleStatement(StringConstStartPos, Result:=FCurCodeTool.GetApplicationTitleStatement(StringConstStartPos,
EndPos,Title); EndPos,Title);
except except

View File

@ -1280,6 +1280,7 @@ begin
InitCollectIdentifiers(CursorPos,IdentifierList); InitCollectIdentifiers(CursorPos,IdentifierList);
ParseSourceTillCollectionStart(CursorPos,CleanCursorPos,CursorNode, ParseSourceTillCollectionStart(CursorPos,CleanCursorPos,CursorNode,
IdentStartPos,IdentEndPos); IdentStartPos,IdentEndPos);
if CleanCursorPos=0 then ;
// find context // find context
{$IFDEF CTDEBUG} {$IFDEF CTDEBUG}
@ -1299,6 +1300,7 @@ begin
FindCollectionContext(Params,IdentStartPos,CursorNode, FindCollectionContext(Params,IdentStartPos,CursorNode,
GatherContext,ContextExprStartPos,StartInSubContext); GatherContext,ContextExprStartPos,StartInSubContext);
if ContextExprStartPos=0 then ;
// search and gather identifiers in context // search and gather identifiers in context
if (GatherContext.Tool<>nil) and (GatherContext.Node<>nil) then begin if (GatherContext.Tool<>nil) and (GatherContext.Node<>nil) then begin
@ -1432,6 +1434,7 @@ var
if not CheckParameterSyntax(CursorNode, CleanCursorPos, if not CheckParameterSyntax(CursorNode, CleanCursorPos,
VarNameAtom, ProcNameAtom, ParameterIndex) VarNameAtom, ProcNameAtom, ParameterIndex)
then begin then begin
if VarNameAtom.StartPos=0 then ;
DebugLn(['TIdentCompletionTool.FindCodeContext.CheckContextIsParameter not in a parameter list']); DebugLn(['TIdentCompletionTool.FindCodeContext.CheckContextIsParameter not in a parameter list']);
exit; exit;
end; end;
@ -1456,6 +1459,7 @@ var
FindCollectionContext(Params,ProcNameAtom.StartPos,CursorNode, FindCollectionContext(Params,ProcNameAtom.StartPos,CursorNode,
GatherContext,ContextExprStartPos,StartInSubContext); GatherContext,ContextExprStartPos,StartInSubContext);
if ContextExprStartPos=0 then ;
//DebugLn(['CheckContextIsParameter StartInSubContext=',StartInSubContext,' ',GatherContext.Node.DescAsString,' "',copy(GatherContext.Tool.Src,GatherContext.Node.StartPos-20,25),'"']); //DebugLn(['CheckContextIsParameter StartInSubContext=',StartInSubContext,' ',GatherContext.Node.DescAsString,' "',copy(GatherContext.Tool.Src,GatherContext.Node.StartPos-20,25),'"']);
// gather declarations of all parameter lists // gather declarations of all parameter lists
@ -1487,6 +1491,8 @@ begin
InitCollectIdentifiers(CursorPos,IdentifierList); InitCollectIdentifiers(CursorPos,IdentifierList);
ParseSourceTillCollectionStart(CursorPos,CleanCursorPos,CursorNode, ParseSourceTillCollectionStart(CursorPos,CleanCursorPos,CursorNode,
IdentStartPos,IdentEndPos); IdentStartPos,IdentEndPos);
if IdentStartPos=0 then ;
if IdentEndPos=0 then ;
// find class and ancestors if existing (needed for protected identifiers) // find class and ancestors if existing (needed for protected identifiers)
FindContextClassAndAncestors(CursorPos,ClassAndAncestors); FindContextClassAndAncestors(CursorPos,ClassAndAncestors);

View File

@ -2364,6 +2364,7 @@ begin
Result:=false; Result:=false;
// search old Application.Title:= statement // search old Application.Title:= statement
OldExists:=FindApplicationTitleStatement(StartPos,StringConstStartPos,EndPos); OldExists:=FindApplicationTitleStatement(StartPos,StringConstStartPos,EndPos);
if StringConstStartPos=0 then ;
if OldExists then begin if OldExists then begin
// replace old statement // replace old statement
Indent:=0; Indent:=0;
@ -2407,6 +2408,7 @@ begin
Result:=true; Result:=true;
exit; exit;
end; end;
if StringConstStartPos=0 then ;
// -> delete whole line // -> delete whole line
FromPos:=FindLineEndOrCodeInFrontOfPosition(StartPos); FromPos:=FindLineEndOrCodeInFrontOfPosition(StartPos);
ToPos:=FindFirstLineEndAfterInCode(EndPos); ToPos:=FindFirstLineEndAfterInCode(EndPos);

View File

@ -1767,6 +1767,7 @@ begin
Result:=mrCancel; Result:=mrCancel;
Src:=aText.Source; Src:=aText.Source;
p:=1; p:=1;
AtomStart:=p;
repeat repeat
ReadRawNextPascalAtom(Src,p,AtomStart); ReadRawNextPascalAtom(Src,p,AtomStart);
if p>length(Src) then break; if p>length(Src) then break;
@ -1923,18 +1924,332 @@ var
NewType.Name:=TypeName; NewType.Name:=TypeName;
NewType.Code:=TypeCode; NewType.Code:=TypeCode;
NewType.MaxPosition:=StartPos; NewType.MaxPosition:=StartPos;
if ImplicitTypes=nil then
ImplicitTypes:=TAvgLvlTree.Create(@CompareImplicitTypeNames);
ImplicitTypes.Add(NewType); ImplicitTypes.Add(NewType);
end; end;
ModalResult:=mrOk; ModalResult:=mrOk;
Result:=true; Result:=true;
end; end;
function FindExplicitTypes(var ModalResult: TModalResult): boolean; function FindExplicitTypesAndConstants(var ModalResult: TModalResult): boolean;
{ every implicit type can contian references to explicit types and constants
For example: array[0..3] of bogus
If 'bogus' is defined in this source, then the new type must be defined
after 'bogus'.
=> Search all explicit types
}
var
TypeStart: LongInt;
TypeEnd: integer; // 0 means invalid
function PosToStr(Position: integer): string;
var
Line, Col: integer;
begin
SrcPosToLineCol(Src,Position,Line,Col);
Result:='(y='+IntToStr(Line)+',x='+IntToStr(Col)+')';
end;
procedure AdjustMinPositions(const Identifier: string);
var
Node: TAvgLvlTreeNode;
Item: TImplicitType;
Position: Integer;
AtomStart: LongInt;
CurAtom: String;
begin
if TypeEnd<1 then exit;
//DebugLn(['AdjustMinPositions Identifier=',Identifier]);
// search Identifier in all implicit type definitions
Node:=ImplicitTypes.FindLowest;
while Node<>nil do begin
Item:=TImplicitType(Node.Data);
if Item.MaxPosition>=TypeEnd then begin
// search Identifier in Item.Code
Position:=1;
AtomStart:=Position;
repeat
CurAtom:=ReadNextPascalAtom(Item.Code,Position,AtomStart);
if CurAtom='' then break;
//DebugLn(['AdjustMinPositions ',Item.Name,' ',CurAtom]);
if CompareIdentifiers(PChar(Identifier),PChar(CurAtom))=0 then begin
// this implicit type depends on an explicit type defined
// prior in this source file
DebugLn(['AdjustMinPositions "',Item.Name,'=',Item.Code,'"',
' depends on ',Identifier,
' defined at ',PosToStr(TypeStart),'-',PosToStr(TypeEnd),
' as "',copy(Src,TypeStart,30),'"']);
if Item.MinPosition<TypeEnd then
Item.MinPosition:=TypeEnd;
break;
end;
until false;
end;
Node:=ImplicitTypes.FindSuccessor(Node);
end;
end;
function ReadTypeDefinition(var Position: integer): boolean; forward;
function ReadWord(var Position: integer): boolean;
var
AtomStart: LongInt;
CurAtom: String;
begin
AtomStart:=Position;
CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
if (CurAtom<>'') and IsIdentStartChar[CurAtom[1]] then
Result:=true
else begin
DebugLn(['ReadWord word not found at ',PosToStr(AtomStart)]);
Result:=false;
end;
end;
function ReadUntilAtom(var Position: integer;
const StopAtom: string): boolean;
var
AtomStart: LongInt;
CurAtom: String;
StartPos: LongInt;
begin
StartPos:=Position;
AtomStart:=Position;
repeat
CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
if CurAtom='' then begin
DebugLn(['ReadUntilAtom atom not found: "',StopAtom,'" (starting at ',PosToStr(StartPos),')']);
exit(false);
end;
until CurAtom=StopAtom;
Result:=true;
end;
function ReadRecord(var Position: integer): boolean;
var
AtomStart: LongInt;
CurAtom: String;
begin
Result:=false;
AtomStart:=Position;
repeat
CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
if CurAtom='' then begin
DebugLn(['ReadRecord record end not found']);
exit;
end else if CurAtom='(' then begin
// skip round bracket open
if not ReadUntilAtom(Position,')') then exit;
end else if CurAtom='[' then begin
// skip edged bracket open
if not ReadUntilAtom(Position,']') then exit;
end else if CompareIdentifiers(PChar(CurAtom),'CASE')=0 then begin
// read identifier
if not ReadWord(Position) then exit;
CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
//DebugLn(['ReadRecord CASE colon or "of" CurAtom="',CurAtom,'"']);
if CurAtom=':' then begin
// read case type
if not ReadWord(Position) then begin
DebugLn(['ReadRecord missing case type at ',PosToStr(Position)]);
exit;
end;
// read 'of'
CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
if CurAtom='' then begin
DebugLn(['ReadRecord missing "of" at ',PosToStr(Position)]);
exit;
end;
end;
if CompareIdentifiers(PChar(CurAtom),'OF')<>0 then begin
DebugLn(['ReadRecord record case "of" not found at ',PosToStr(AtomStart)]);
exit;
end;
end else if CurAtom=':' then begin
// skip type
CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
if CurAtom='(' then begin
// skip case brackets
if not ReadUntilAtom(Position,')') then exit;
end else begin
// read normal type
Position:=AtomStart;
if not ReadTypeDefinition(Position) then exit;
end;
end;
until CompareIdentifiers(PChar(CurAtom),'END')=0;
Result:=true;
end;
function ReadClass(var Position: integer): boolean;
var
AtomStart: LongInt;
CurAtom: String;
begin
//DebugLn(['ReadClass at ',PosToStr(Position)]);
Result:=false;
AtomStart:=Position;
CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
//DebugLn(['ReadClass first atom "',CurAtom,'"']);
if CurAtom=';' then begin
// this is a forward class definition
//DebugLn(['ReadClass forward defined class found']);
Result:=true;
exit;
end;
repeat
CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
//DebugLn(['ReadClass CurAtom="',CurAtom,'"']);
if CurAtom='' then begin
DebugLn(['ReadClass class end not found']);
exit;
end else if CurAtom='(' then begin
// skip round bracket open
if not ReadUntilAtom(Position,')') then exit;
end else if CurAtom='[' then begin
// skip edged bracket open
if not ReadUntilAtom(Position,']') then exit;
end else if CurAtom=':' then begin
// skip type
if not ReadTypeDefinition(Position) then exit;
end;
until CompareIdentifiers(PChar(CurAtom),'END')=0;
Result:=true;
end;
function ReadTypeDefinition(var Position: integer): boolean;
var
AtomStart: LongInt;
CurAtom: String;
Enum: String;
begin
//DebugLn(['ReadTypeDefinition reading type definition at ',PosToStr(Position)]);
Result:=false;
AtomStart:=Position;
CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
if CurAtom='(' then begin
// enumeration constants
//DebugLn(['ReadTypeDefinition enumeration found at ',PosToStr(AtomStart)]);
repeat
Enum:=ReadNextPascalAtom(Src,Position,AtomStart);
if (Enum='') then exit;// missing bracket close
if Enum=')' then exit(true);// type end found
if (not IsIdentStartChar[Enum[1]]) then exit;// enum missing
//DebugLn(['ReadTypeDefinition enum ',Enum,' found at ',PosToStr(AtomStart)]);
AdjustMinPositions(Enum);
CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
if CurAtom=')' then exit(true);// type end found
if CurAtom<>',' then exit;// comma missing
until false;
end;
repeat
//DebugLn(['ReadTypeDefinition CurAtom="',CurAtom,'"']);
if CurAtom='' then begin
DebugLn(['ReadTypeDefinition type end not found']);
exit;
end;
if IsIdentStartChar[CurAtom[1]] then begin
if CompareIdentifiers(PChar(CurAtom),'RECORD')=0 then begin
// skip record
Result:=ReadRecord(Position);
exit;
end;
if (CompareIdentifiers(PChar(CurAtom),'CLASS')=0)
or (CompareIdentifiers(PChar(CurAtom),'OBJECT')=0)
or (CompareIdentifiers(PChar(CurAtom),'INTERFACE')=0)
or (CompareIdentifiers(PChar(CurAtom),'DISPINTERFACE')=0)
then begin
// skip record
Result:=ReadClass(Position);
exit;
end;
end else if CurAtom='(' then begin
// skip round bracket open
if not ReadUntilAtom(Position,')') then exit;
end else if CurAtom='[' then begin
// skip edged bracket open
if not ReadUntilAtom(Position,']') then exit;
end else if CurAtom=';' then
break;
CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
until false;
Result:=true;
end;
var
Position: Integer;
AtomStart: LongInt;
CurAtom: String;
Identifier: String;
TypeDefStart: LongInt;
begin begin
Result:=false; Result:=false;
ModalResult:=mrCancel; ModalResult:=mrCancel;
Position:=1;
AtomStart:=Position;
repeat
CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
//DebugLn(['FindExplicitTypes CurAtom="',CurAtom,'"']);
if CurAtom='' then break;
if CompareIdentifiers(PChar(CurAtom),'type')=0 then begin
// type section found
//DebugLn(['FindExplicitTypes type section found at ',PosToStr(AtomStart)]);
repeat
Identifier:=ReadNextPascalAtom(Src,Position,AtomStart);
if (Identifier<>'') and (IsIdentStartChar[Identifier[1]]) then begin
// word found (can be an identifier or start of next section)
TypeStart:=AtomStart;
CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
if CurAtom<>'=' then begin
DebugLn(['FindExplicitTypes type section ended at ',PosToStr(AtomStart)]);
break;
end;
// Identifier is a type => find end of type definition
//DebugLn(['FindExplicitTypes type definition found: ',Identifier,' at ',PosToStr(TypeStart)]);
TypeEnd:=0;
TypeDefStart:=Position;
Result:=ReadTypeDefinition(Position);
if not Result then begin
DebugLn(['FindExplicitTypes FAILED reading type definition ',Identifier,' at ',PosToStr(TypeStart)]);
exit;
end;
TypeEnd:=Position;
// add the semicolon, if not already done
CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
if CurAtom=';' then
TypeEnd:=Position;
// adjust implicit identifiers
AdjustMinPositions(Identifier);
// reread the type for the enums
Position:=TypeDefStart;
//DebugLn(['FindExplicitTypes Rereading type definition ',Identifier,' at ',PosToStr(TypeStart)]);
Result:=ReadTypeDefinition(Position);
if not Result then begin
DebugLn(['FindExplicitTypes FAILED Rereading type definition ',Identifier,' at ',PosToStr(TypeStart)]);
exit;
end;
// skip semicolon
Position:=TypeEnd;
end;
until false;
end
else if CompareIdentifiers(PChar(CurAtom),'const')=0 then begin
{ ToDo
repeat
Identifier:=ReadNextPascalAtom(Src,Position,AtomStart);
if (Identifier<>'') and (IsIdentStartChar[Identifier[1]]) then begin
end else if CurAtom=':' then begin
end else begin
end;
until false;}
end;
until false;
ModalResult:=mrOk; ModalResult:=mrOk;
Result:=true; Result:=true;
end; end;
@ -1947,8 +2262,13 @@ var
ModalResult:=mrCancel; ModalResult:=mrCancel;
if (ImplicitTypes<>nil) then begin if (ImplicitTypes<>nil) then begin
// find all explicit types // find all explicit types
if not FindExplicitTypes(ModalResult) then exit; // ToDo: find constants, use constant section end as MinPosition
if not FindExplicitTypesAndConstants(ModalResult) then exit;
// now all min and max positions for the new types are known
// ToDo: resort the ImplicitTypes for MinPosition
// ToDo: Insert every type
Node:=ImplicitTypes.FindLowest; Node:=ImplicitTypes.FindLowest;
while Node<>nil do begin while Node<>nil do begin
@ -1973,10 +2293,14 @@ begin
if not SearchImplicitParameterTypes(Result) then exit; if not SearchImplicitParameterTypes(Result) then exit;
if not AdjustMinPositions(Result) then exit; if not AdjustMinPositions(Result) then exit;
finally finally
ImplicitTypes.FreeAndClear; if ImplicitTypes<>nil then begin
ImplicitTypes.Free; ImplicitTypes.FreeAndClear;
ExplicitTypes.FreeAndClear; ImplicitTypes.Free;
ExplicitTypes.Free; end;
if ExplicitTypes<>nil then begin
ExplicitTypes.FreeAndClear;
ExplicitTypes.Free;
end;
end; end;
Result:=mrOk; Result:=mrOk;
end; end;

View File

@ -0,0 +1,17 @@
SimpleIDEIntf
=============
This package simulates a simple IDE to allow testing IDE experts at command
line. It fills several objects and functions of the IDEIntf.
For example:
examples/testh2pastool.lpi
The h2paswizard package provides an IDE menu item, a dialog and several text
tools to parse and change sources. The example project demonstrates how to
use the SimpleIDEIntf package to test the text tools of the h2paswizard with
a command line program, which compiles fast and can be debugged easier than
the package in the IDE.
./testh2pastool files/h2pastest.pas

View File

@ -0,0 +1,25 @@
type
TMyClass = class;
TMyEnums = (enum1, enum2);
TMySet = set of TMyEnums;
TMyClass = class(TObject)
procedure DoSomething(var a: array[0..3] of char);
end;
TMyRecord = record
i: integer;
case b: boolean of
true: (AsInt: integer);
false: (AsWord: word);
end;
// this procedure contains an explicit/anoymous type, which is not allowed
// in FreePascal. The TReplaceImplicitTypes tool will replace it with a
// named type
procedure DoSomething(var a: array[0..3] of TMyClass);

View File

@ -0,0 +1,282 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="/"/>
<Version Value="5"/>
<General>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=""/>
<ActiveEditorIndexAtStart Value="1"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
<Language Value=""/>
<CharSet Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="CodeTools"/>
</Item1>
<Item2>
<PackageName Value="SimpleIDEIntf"/>
<MinVersion Valid="True"/>
</Item2>
<Item3>
<PackageName Value="H2PasWizard"/>
<MinVersion Valid="True"/>
</Item3>
</RequiredPackages>
<Units Count="16">
<Unit0>
<Filename Value="testh2pastool.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="TestH2pasTool"/>
<CursorPos X="23" Y="36"/>
<TopLine Value="28"/>
<EditorIndex Value="0"/>
<UsageCount Value="27"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="../h2pasconvert.pas"/>
<UnitName Value="H2PasConvert"/>
<CursorPos X="4" Y="31"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
</Unit1>
<Unit2>
<Filename Value="../../../../freepascal/fpc/rtl/inc/objpash.inc"/>
<CursorPos X="23" Y="121"/>
<TopLine Value="99"/>
<UsageCount Value="9"/>
</Unit2>
<Unit3>
<Filename Value="../../../ideintf/idetextconverter.pas"/>
<UnitName Value="IDETextConverter"/>
<CursorPos X="14" Y="176"/>
<TopLine Value="154"/>
<UsageCount Value="10"/>
</Unit3>
<Unit4>
<Filename Value="../../../ide/sourceeditprocs.pas"/>
<UnitName Value="SourceEditProcs"/>
<CursorPos X="1" Y="575"/>
<TopLine Value="561"/>
<UsageCount Value="10"/>
</Unit4>
<Unit5>
<Filename Value="../../../ideintf/texttools.pas"/>
<UnitName Value="TextTools"/>
<CursorPos X="19" Y="109"/>
<TopLine Value="75"/>
<UsageCount Value="10"/>
</Unit5>
<Unit6>
<Filename Value="../simpleide.pas"/>
<UnitName Value="SimpleIDE"/>
<CursorPos X="3" Y="138"/>
<TopLine Value="112"/>
<UsageCount Value="10"/>
</Unit6>
<Unit7>
<Filename Value="../README.txt"/>
<CursorPos X="1" Y="15"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
<SyntaxHighlighter Value="None"/>
</Unit7>
<Unit8>
<Filename Value="files/h2pastest.pas"/>
<UnitName Value="h2pasTest"/>
<CursorPos X="53" Y="23"/>
<TopLine Value="1"/>
<EditorIndex Value="4"/>
<UsageCount Value="24"/>
<Loaded Value="True"/>
</Unit8>
<Unit9>
<Filename Value="../../codetools/fileprocs.pas"/>
<UnitName Value="FileProcs"/>
<CursorPos X="3" Y="355"/>
<TopLine Value="345"/>
<UsageCount Value="10"/>
</Unit9>
<Unit10>
<Filename Value="../../h2pas/h2pasconvert.pas"/>
<UnitName Value="H2PasConvert"/>
<CursorPos X="11" Y="2241"/>
<TopLine Value="2213"/>
<EditorIndex Value="1"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit10>
<Unit11>
<Filename Value="/home/gaertner/pascal/amat/ide/copycomponent/componentcopier.pas"/>
<UnitName Value="ComponentCopier"/>
<CursorPos X="1" Y="19"/>
<TopLine Value="19"/>
<EditorIndex Value="3"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit11>
<Unit12>
<Filename Value="../../codetools/basiccodetools.pas"/>
<UnitName Value="BasicCodeTools"/>
<CursorPos X="1" Y="2050"/>
<TopLine Value="2026"/>
<EditorIndex Value="2"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit12>
<Unit13>
<Filename Value="../../codetools/codetoolmanager.pas"/>
<UnitName Value="CodeToolManager"/>
<CursorPos X="1" Y="1953"/>
<TopLine Value="1932"/>
<UsageCount Value="10"/>
</Unit13>
<Unit14>
<Filename Value="../../codetools/stdcodetools.pas"/>
<UnitName Value="StdCodeTools"/>
<CursorPos X="34" Y="2367"/>
<TopLine Value="2336"/>
<UsageCount Value="10"/>
</Unit14>
<Unit15>
<Filename Value="../../codetools/identcompletiontool.pas"/>
<UnitName Value="IdentCompletionTool"/>
<CursorPos X="38" Y="1437"/>
<TopLine Value="1413"/>
<UsageCount Value="10"/>
</Unit15>
</Units>
<JumpHistory Count="26" HistoryIndex="25">
<Position1>
<Filename Value="../../codetools/basiccodetools.pas"/>
<Caret Line="2041" Column="10" TopLine="2022"/>
</Position1>
<Position2>
<Filename Value="../../h2pas/h2pasconvert.pas"/>
<Caret Line="1946" Column="39" TopLine="1933"/>
</Position2>
<Position3>
<Filename Value="../../h2pas/h2pasconvert.pas"/>
<Caret Line="2211" Column="20" TopLine="2203"/>
</Position3>
<Position4>
<Filename Value="../../codetools/basiccodetools.pas"/>
<Caret Line="104" Column="10" TopLine="82"/>
</Position4>
<Position5>
<Filename Value="../../codetools/basiccodetools.pas"/>
<Caret Line="411" Column="24" TopLine="384"/>
</Position5>
<Position6>
<Filename Value="../../codetools/basiccodetools.pas"/>
<Caret Line="749" Column="26" TopLine="721"/>
</Position6>
<Position7>
<Filename Value="../../codetools/basiccodetools.pas"/>
<Caret Line="783" Column="27" TopLine="751"/>
</Position7>
<Position8>
<Filename Value="../../codetools/basiccodetools.pas"/>
<Caret Line="1610" Column="8" TopLine="1586"/>
</Position8>
<Position9>
<Filename Value="../../codetools/basiccodetools.pas"/>
<Caret Line="1440" Column="29" TopLine="1417"/>
</Position9>
<Position10>
<Filename Value="../../codetools/basiccodetools.pas"/>
<Caret Line="1439" Column="11" TopLine="1417"/>
</Position10>
<Position11>
<Filename Value="../../codetools/basiccodetools.pas"/>
<Caret Line="275" Column="30" TopLine="274"/>
</Position11>
<Position12>
<Filename Value="../../codetools/basiccodetools.pas"/>
<Caret Line="2032" Column="15" TopLine="2010"/>
</Position12>
<Position13>
<Filename Value="../../h2pas/h2pasconvert.pas"/>
<Caret Line="1948" Column="7" TopLine="1926"/>
</Position13>
<Position14>
<Filename Value="../../h2pas/h2pasconvert.pas"/>
<Caret Line="1772" Column="26" TopLine="1749"/>
</Position14>
<Position15>
<Filename Value="../../codetools/basiccodetools.pas"/>
<Caret Line="84" Column="10" TopLine="62"/>
</Position15>
<Position16>
<Filename Value="../../codetools/basiccodetools.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position16>
<Position17>
<Filename Value="../../h2pas/h2pasconvert.pas"/>
<Caret Line="2158" Column="27" TopLine="2156"/>
</Position17>
<Position18>
<Filename Value="../../h2pas/h2pasconvert.pas"/>
<Caret Line="2181" Column="26" TopLine="2156"/>
</Position18>
<Position19>
<Filename Value="../../h2pas/h2pasconvert.pas"/>
<Caret Line="2010" Column="33" TopLine="2001"/>
</Position19>
<Position20>
<Filename Value="../../h2pas/h2pasconvert.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position20>
<Position21>
<Filename Value="../../h2pas/h2pasconvert.pas"/>
<Caret Line="1963" Column="55" TopLine="1941"/>
</Position21>
<Position22>
<Filename Value="../../h2pas/h2pasconvert.pas"/>
<Caret Line="2124" Column="55" TopLine="2102"/>
</Position22>
<Position23>
<Filename Value="../../h2pas/h2pasconvert.pas"/>
<Caret Line="2212" Column="69" TopLine="2190"/>
</Position23>
<Position24>
<Filename Value="../../h2pas/h2pasconvert.pas"/>
<Caret Line="2224" Column="62" TopLine="2202"/>
</Position24>
<Position25>
<Filename Value="../../h2pas/h2pasconvert.pas"/>
<Caret Line="2252" Column="19" TopLine="2242"/>
</Position25>
<Position26>
<Filename Value="../../h2pas/h2pasconvert.pas"/>
<Caret Line="2253" Column="17" TopLine="2228"/>
</Position26>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

View File

@ -0,0 +1,71 @@
{ Copyright (C) 2007 Mattias Gaertner
This source is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
Software Foundation; either version 2 of the License, or (at your option)
any later version.
This code is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
details.
A copy of the GNU General Public License is available on the World Wide Web
at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
MA 02111-1307, USA.
Abstract:
Program to test single conversion tools.
}
program TestH2pasTool;
{$mode objfpc}{$H+}
uses
Classes, SysUtils, H2PasWizard, H2PasConvert, IDETextConverter, SimpleIDEIntf,
FileUtil;
procedure TestTReplaceImplicitTypes(Converter: TIDETextConverter);
var
Tool: TReplaceImplicitTypes;
begin
Tool:=nil;
try
Tool:=TReplaceImplicitTypes.Create(nil);
Tool.Execute(Converter);
finally
Tool.Free;
end;
end;
var
Filename: String;
Converter: TIDETextConverter;
TempFilename: String;
begin
if ParamCount<1 then
raise Exception.Create('Missing filename');
Filename:=ParamStr(1);
if not FileExists(Filename) then
raise Exception.Create('File not found: "'+Filename+'"');
Converter:=nil;
try
// create a copy of the file, so that the test does no harm
TempFilename:=TextConverterToolClasses.GetTempFilename;
CopyFile(Filename,TempFilename,false);
// create the converter
Converter:=TIDETextConverter.Create(nil);
Converter.InitWithFilename(TempFilename);
// test
TestTReplaceImplicitTypes(Converter);
// write result
writeln(Converter.Source);
finally
Converter.Free;
end;
end.

View File

@ -0,0 +1,156 @@
{ Copyright (C) 2007 Mattias Gaertner
This source is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
Software Foundation; either version 2 of the License, or (at your option)
any later version.
This code is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
details.
A copy of the GNU General Public License is available on the World Wide Web
at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
MA 02111-1307, USA.
Abstract:
}
unit SimpleIDE;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, TextTools, SynRegExpr, FileProcs,
IDETextConverter;
type
{ TLazyTextConverterToolClasses }
TLazyTextConverterToolClasses = class(TTextConverterToolClasses)
protected
function GetTempFilename: string; override;
function LoadFromFile(Converter: TIDETextConverter; const AFilename: string;
UpdateFromDisk, Revert: Boolean): Boolean; override;
end;
procedure SetupTextConverters;
procedure FreeTextConverters;
implementation
var
SynREEngine: TRegExpr;
procedure InitSynREEngine;
begin
if SynREEngine=nil then
SynREEngine:=TRegExpr.Create;
end;
function SynREMatches(const TheText, RegExpr, ModifierStr: string;
StartPos: integer): boolean;
begin
InitSynREEngine;
SynREEngine.ModifierStr:=ModifierStr;
SynREEngine.Expression:=RegExpr;
SynREEngine.InputString:=TheText;
Result:=SynREEngine.ExecPos(StartPos);
end;
function SynREVar(Index: Integer): string;
begin
if SynREEngine<>nil then
Result:=SynREEngine.Match[Index]
else
Result:='';
end;
procedure SynREVarPos(Index: Integer; out MatchStart, MatchLength: integer);
begin
if SynREEngine<>nil then begin
MatchStart:=SynREEngine.MatchPos[Index];
MatchLength:=SynREEngine.MatchLen[Index];
end else begin
MatchStart:=-1;
MatchLength:=-1;
end;
end;
function SynREVarCount: Integer;
begin
if SynREEngine<>nil then
Result:=SynREEngine.SubExprMatchCount
else
Result:=0;
end;
function SynREReplace(const TheText, FindRegExpr, ReplaceRegExpr: string;
UseSubstutition: boolean; const ModifierStr: string): string;
begin
InitSynREEngine;
SynREEngine.ModifierStr:=ModifierStr;
SynREEngine.Expression:=FindRegExpr;
Result:=SynREEngine.Replace(TheText,ReplaceRegExpr,UseSubstutition);
end;
procedure SynRESplit(const TheText, SeparatorRegExpr: string; Pieces: TStrings;
const ModifierStr: string);
begin
InitSynREEngine;
SynREEngine.ModifierStr:=ModifierStr;
SynREEngine.Expression:=SeparatorRegExpr;
SynREEngine.Split(TheText,Pieces);
end;
procedure SetupTextConverters;
begin
if TextConverterToolClasses<>nil then
raise Exception.Create('SimpleIDE: TextConverterToolClasses<>nil');
TextConverterToolClasses:=TLazyTextConverterToolClasses.Create;
TextConverterToolClasses.RegisterClass(TTextReplaceTool);
end;
procedure FreeTextConverters;
begin
FreeAndNil(TextConverterToolClasses);
end;
{ TLazyTextConverterToolClasses }
function TLazyTextConverterToolClasses.GetTempFilename: string;
var
BaseDir: String;
begin
BaseDir:=GetCurrentDir;
Result:=FileProcs.GetTempFilename(BaseDir,'convert_');
end;
function TLazyTextConverterToolClasses.LoadFromFile(
Converter: TIDETextConverter; const AFilename: string; UpdateFromDisk,
Revert: Boolean): Boolean;
begin
Result:=Converter.LoadFromFile(AFilename,false,UpdateFromDisk,Revert);
end;
initialization
REException:=ERegExpr;
REMatchesFunction:=@SynREMatches;
REVarFunction:=@SynREVar;
REVarPosProcedure:=@SynREVarPos;
REVarCountFunction:=@SynREVarCount;
REReplaceProcedure:=@SynREReplace;
RESplitFunction:=@SynRESplit;
SetupTextConverters;
finalization
FreeTextConverters;
FreeAndNil(SynREEngine);
end.

View File

@ -0,0 +1,47 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="2">
<Name Value="SimpleIDEIntf"/>
<CompilerOptions>
<Version Value="5"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Files Count="1">
<Item1>
<Filename Value="simpleide.pas"/>
<UnitName Value="simpleide"/>
</Item1>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="4">
<Item1>
<PackageName Value="CodeTools"/>
</Item1>
<Item2>
<PackageName Value="SynEdit"/>
</Item2>
<Item3>
<PackageName Value="IDEIntf"/>
</Item3>
<Item4>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item4>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>
</CONFIG>

View File

@ -0,0 +1,20 @@
{ Diese Datei wurde automatisch von Lazarus erzeugt. Sie darf nicht bearbeitet werden!
Dieser Quelltext dient nur dem Übersetzen und Installieren des Packages.
}
unit SimpleIDEIntf;
interface
uses
SimpleIDE, LazarusPackageIntf;
implementation
procedure Register;
begin
end;
initialization
RegisterPackage('SimpleIDEIntf', @Register);
end.

View File

@ -115,7 +115,7 @@ each control that's dropped onto the form
// component // component
FSelection: TPersistentSelectionList; FSelection: TPersistentSelectionList;
FObj_Inspector: TObjectInspector; FObj_Inspector: TObjectInspector;
FDefineProperties: TAVLTree; FDefineProperties: TAVLTree;// tree of TDefinePropertiesCacheItem
FStandardDefinePropertiesRegistered: Boolean; FStandardDefinePropertiesRegistered: Boolean;
function GetPropertyEditorHook: TPropertyEditorHook; function GetPropertyEditorHook: TPropertyEditorHook;
function FindDefinePropertyNode(const APersistentClassName: string function FindDefinePropertyNode(const APersistentClassName: string

View File

@ -39,9 +39,11 @@ var
SortTextFunc: TSortTextFunc; SortTextFunc: TSortTextFunc;
{ Regular expressions { Regular expressions
This is a simple interface to regular expressions. The syntax is similar This is a simple interface to regular expressions. The syntax is similar
to Perl regular expressions. An illegal pattern will raise an Exception. to Perl regular expressions. An illegal pattern will raise an Exception.
Important: These functions are not thread safe!
REMatches - function to test a regular expression. REMatches - function to test a regular expression.
REVar - function to read the bracket values, found in the last call REVar - function to read the bracket values, found in the last call

View File

@ -528,7 +528,7 @@ type
procedure SetProportional(const AValue: Boolean); procedure SetProportional(const AValue: Boolean);
procedure SetStretch(Value : Boolean); procedure SetStretch(Value : Boolean);
procedure SetTransparent(Value : Boolean); procedure SetTransparent(Value : Boolean);
procedure PictureChanged(SEnder : TObject); procedure PictureChanged(Sender : TObject);
protected protected
function DestRect: TRect; virtual; function DestRect: TRect; virtual;
procedure DoAutoSize; Override; procedure DoAutoSize; Override;