Delphi/pascalscript
Delphi/pascalscript
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Patches for the unit importer by Alexander Federyakov.

Browse Source 
git-svn-id: http://code.remobjects.com/svn/pascalscript@242 5c9d2617-0215-0410-a2ee-e80e04d1c6d8
This commit is contained in:
ck 2010-12-08 12:19:49 +00:00
parent 69b6a9418e
commit 8414bbac43
9 changed files with 85 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Samples/Import/Import.dpr
View File

@ -1,6 +1,8 @@
program Import;
uses
FastMM4Messages in '..\..\..\lib\elitedev\lib\FastMM4Messages.pas',
FastMM4 in '..\..\..\lib\elitedev\lib\FastMM4.pas',
Forms,
fMain in 'fMain.pas' {MainForm},
fDwin in 'fDwin.pas' {dwin};

BIN
Samples/Import/Import.res
View File

Binary file not shown.

BIN
Samples/Import/fMain.dfm
View File

Binary file not shown.

5
Samples/Import/fMain.pas
View File

@ -4,7 +4,7 @@ interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, uPSCompiler, uPSRuntime, uPSPreprocessor, uPSUtils,
ExtCtrls, StdCtrls, uPSCompiler, uPSRuntime, uPSDisassembly, uPSPreprocessor, uPSUtils,
Menus, uPSC_comobj, uPSR_comobj;
type
@ -55,7 +55,7 @@ var
implementation
uses
uPSDisassembly, uPSC_dll, uPSR_dll, uPSDebugger,
uPSC_dll, uPSR_dll, uPSDebugger,
uPSR_std, uPSC_std, uPSR_stdctrls, uPSC_stdctrls,
uPSR_forms, uPSC_forms,
@ -220,6 +220,7 @@ begin
x1.OnExportCheck := MyExportCheck;
x1.OnUses := MyOnUses;
x1.OnExternalProc := DllExternalProc;
x1.AllowNoEnd := true;
if x1.Compile(s) then
begin
Outputtxt('Succesfully compiled');

3
Samples/TestApp/TestApplication.dpr
View File

@ -2,7 +2,8 @@ program TestApplication;
uses
Forms,
fMain in 'fMain.pas' {Form1};
fMain in 'fMain.pas' {Form1},
uPSComponent_COM in '..\..\Source\uPSComponent_COM.pas';
{$R *.RES}

BIN
Samples/TestApp/fMain.dfm
View File

Binary file not shown.

11
Samples/TestApp/fMain.pas
View File

@ -4,7 +4,7 @@ interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, uPSComponent, uPSCompiler, Menus, uPSRuntime;
ExtCtrls, StdCtrls, uPSComponent, uPSCompiler, Menus, uPSRuntime, Variants;
type
TForm1 = class(TForm)
@ -45,7 +45,9 @@ uses
uPSC_classes,
uPSR_graphics,
uPSR_controls,
uPSR_classes;
uPSR_classes,
uPSC_comobj,
uPSR_comobj;
{$R *.DFM}
@ -58,6 +60,7 @@ begin
SIRegister_Controls(x);
SIRegister_stdctrls(x);
SIRegister_Forms(x);
SIRegister_ComObj(x);
end;
procedure TForm1.IFPS3ClassesPlugin1ExecImport(Sender: TObject; Exec: TIFPSExec;
@ -69,6 +72,7 @@ begin
RIRegister_Controls(x);
RIRegister_stdctrls(x);
RIRegister_Forms(x);
RIRegister_ComObj(exec);
end;
function ImportTest(S1: string; s2: Longint; s3: Byte; s4: word; var s5: string): string;
@ -92,6 +96,7 @@ begin
Sender.AddFunction(@MyWriteln, 'procedure Writeln(s: string);');
Sender.AddFunction(@MyReadln, 'function Readln(question: string): string;');
Sender.AddFunction(@ImportTest, 'function ImportTest(S1: string; s2: Longint; s3: Byte; s4: word; var s5: string): string;');
Sender.AddRegisteredVariable('vars', 'Variant');
Sender.AddRegisteredVariable('Application', 'TApplication');
Sender.AddRegisteredVariable('Self', 'TForm');
Sender.AddRegisteredVariable('Memo1', 'TMemo');
@ -116,6 +121,7 @@ procedure TForm1.Compile1Click(Sender: TObject);
end;
end;
end;
var v: VAriant;
begin
Memo2.Lines.Clear;
PSScript.Script.Assign(Memo1.Lines);
@ -142,6 +148,7 @@ begin
PSScript.SetVarToInstance('SELF', Self);
PSScript.SetVarToInstance('MEMO1', Memo1);
PSScript.SetVarToInstance('MEMO2', Memo2);
PPSVariantVariant(PSScript.GetVariable('VARS'))^.Data := VarArrayCreate([0, 1], varShortInt)
end;
end.

46
unit-importing/Main.pas
View File

@ -78,6 +78,8 @@ type
FFile : string;
fOutputDir : String;
fPrifix : String;
FAfterInterfaceDeclaration: string;
FAutoRenameOverloadedMethods: Boolean;
fLastUsed : TStringList;
FUseUnitAtDT: Boolean;
FSingleUnit : Boolean;
@ -90,6 +92,7 @@ type
procedure SaveLastUsedList;
procedure BuildLastUsedMenu(aMenuItem:TMenuItem);
procedure mnuLastUsedClick(Sender: TObject);
procedure WriteSetttingsToIni(const AIni: TIniFile);
public
constructor Create(aOwner:TComponent);override;
destructor Destroy;override;
@ -218,6 +221,9 @@ begin
Parser.ReadLn := ReadLn;
Parser.UseUnitAtDT := FUseUnitAtDT;
Parser.SingleUnit := FSingleUnit;
Parser.UnitPrefix := fPrifix;
Parser.AfterInterfaceDeclaration := FAfterInterfaceDeclaration;
Parser.AutoRenameOverloadedMethods := FAutoRenameOverloadedMethods;
try
Parser.ParseUnit((Tabcontrol1.tabs.Objects[0] as tStringList).Text);
@ -290,7 +296,9 @@ begin
ExtractFilePath(Application.ExeName) + 'Import\');
FSingleUnit := fIniFile.ReadBool('Main','SingleUnit',True);
FUseUnitAtDT := fIniFile.ReadBool('Main','UseUnitAtDT',False);
fPrifix := fIniFile.ReadString('Main','FilePrefix', 'IFSI');
fPrifix := fIniFile.ReadString('Main','FilePrefix', 'uPS');
FAfterInterfaceDeclaration := fIniFile.ReadString('Main','AfterInterfaceDeclaration', '');
FAutoRenameOverloadedMethods := fIniFile.ReadBool('Main','AutoRenameOverloadedMethods', False);
finally
fIniFile.Free;
end;
@ -372,10 +380,7 @@ begin
If default.Checked then begin
fIniFile := TIniFile.create(ExtractFilePath(Application.ExeName)+'Default.ini');
Try
fIniFile.WriteString('Main','OutputDir', fOutputDir);
fIniFile.WriteBool('Main','SingleUnit' , FSingleUnit);
fIniFile.WriteBool('Main','UseUnitAtDT', FUseUnitAtDT);
fIniFile.WriteString('Main','FilePrefix', fPrifix);
WriteSetttingsToIni(fIniFile);
finally
fIniFile.Free;
end;
@ -383,10 +388,7 @@ begin
if ffile <> '' then begin
fIniFile := TIniFile.create(ChangeFileExt(FFile,'.iip'));
Try
fIniFile.WriteString('Main','OutputDir', fOutputDir);
fIniFile.WriteBool('Main','SingleUnit',FSingleUnit);
fIniFile.WriteBool('Main','UseUnitAtDT',FUseUnitAtDT);
fIniFile.WriteString('Main','FilePrefix', fPrifix);
WriteSetttingsToIni(fIniFile);
finally
fIniFile.Free;
end;
@ -410,16 +412,6 @@ var
end;
begin
FFile := aFileName;
fIniFile := TIniFile.create(ChangeFileExt(FFile,'.iip'));
Try
fOutPutDir := fIniFile.ReadString('Main','OutputDir',fOutPutDir);
FFile := fIniFile.ReadString('Files','File0', fFile);
FSingleUnit := fIniFile.ReadBool('Main','SingleUnit',FSingleUnit);
FUseUnitAtDT := fIniFile.ReadBool('Main','UseUnitAtDT',FUseUnitAtDT);
fPrifix := fIniFile.ReadString('Main','FilePrefix', fPrifix);
finally
fIniFile.Free;
end;
ClearTabs;
TabControl1Changing(Self, AllowChange);
TabControl1.Tabs.AddObject(ExtractFileName(FFile), GetText(FFile));
@ -452,11 +444,7 @@ begin
Try
fIniFile := TIniFile.create(ChangeFileExt(FFile,'.iip'));
Try
fIniFile.WriteString('Main','OutputDir', fOutputDir);
fIniFile.WriteString('Files','File0', fFile);
fIniFile.WriteBool('Main','SingleUnit',FSingleUnit);
fIniFile.WriteBool('Main','UseUnitAtDT',FUseUnitAtDT);
fIniFile.WriteString('Main','FilePrefix', fPrifix);
WriteSetttingsToIni(fIniFile);
finally
fIniFile.Free;
end;
@ -698,4 +686,14 @@ begin
stbMain.Panels[0].Text := Format(StatusLabel,[Editor.CaretY, Editor.CaretX]);
end;
procedure TfrmMain.WriteSetttingsToIni(const AIni: TIniFile);
begin
AIni.WriteString('Main','OutputDir', fOutputDir);
AIni.WriteBool('Main','SingleUnit' , FSingleUnit);
AIni.WriteBool('Main','UseUnitAtDT', FUseUnitAtDT);
AIni.WriteString('Main','FilePrefix', fPrifix);
AIni.WriteString('Main','AfterInterfaceDeclaration', FAfterInterfaceDeclaration);
AIni.WriteBool('Main','AutoRenameOverloadedMethods', FAutoRenameOverloadedMethods);
end;
end.

57
unit-importing/ParserU.pas
View File

@ -12,7 +12,7 @@ unit ParserU;
{version: 20041219}
interface
uses uPSUtils, SysUtils, ParserUtils, BigIni, Classes;
uses uPSUtils, SysUtils, StrUtils, ParserUtils, BigIni, Classes;
type
TProcAttr = set of (PublicProc, IsDone, IsHelper);
@ -51,6 +51,8 @@ type
fCompPrefix : String;
FSingleUnit: Boolean;
FCompileTimeFunctions : Boolean;
FAfterInterfaceDeclaration: string;
FAutoRenameOverloadedMethods: Boolean;
procedure SetWriteln(aWriteln: TWriteln);
procedure SetReadln(aReadln: TReadln);
private
@ -58,6 +60,7 @@ type
fToken, fPrevToken: TPasToken;
// fprevOrgToken: string;
Ini: TBigIniFile;
FRenamingHelper: Integer;
private
LastTokens: array of TPasToken;
FTail, FHead, TokenHistoryCount, TokenHistoryLength: integer;
@ -154,6 +157,9 @@ type
property UnitPrefix : string read FUnitPrefix write FUnitPrefix; // teo
property CompPage : String read FCompPage write FCompPage; // Niels
property CompPrefix : String read FCompPrefix write FCompPrefix; // Niels
property AfterInterfaceDeclaration: string read FAfterInterfaceDeclaration write FAfterInterfaceDeclaration;
property AutoRenameOverloadedMethods: Boolean read FAutoRenameOverloadedMethods write FAutoRenameOverloadedMethods;
property OutUnitList : TStringList read FOutUnitList; // teo
end; {TUnitParser}
@ -175,6 +181,22 @@ procedure DefWriteln(const S: string);
begin
end; {DefWriteln}
// Some method declaratinos may be very long.
// Delphi can't compile these, so we need to spit them manually.
function SplitIntoLines(AString: string): string;
const
cSplitPosition: Byte = 200;
begin
Result := '';
while (Length(AString) > cSplitPosition) do
begin
Result := Result + LeftStr(AString, cSplitPosition) +
''' +' + #13 + #10 + ' ''';
Delete(AString, 1, cSplitPosition);
end;
Result := Result + AString;
end;
constructor TUnitParser.Create(const IniFilename: string; aTokenHistoryLength: Integer = 5);
begin
inherited create;
@ -505,6 +527,7 @@ begin
OutPut.Add(GetLicence);
// OutPut.Add('{$I PascalScript.inc}');
OutPut.Add('interface');
OutPut.Add(FAfterInterfaceDeclaration);
OutPut.Add(GetUsedUnitList(fCompileTimeUnitList) + Newline);
for Index := FCompileTimeProcList.count - 1 downto 0 do
@ -588,6 +611,7 @@ begin
OutPut.Add(GetLicence);
// OutPut.Add('{$I PascalScript.inc}');
OutPut.Add('interface');
OutPut.Add(FAfterInterfaceDeclaration);
OutPut.Add(GetUsedUnitList(fRunTimeUnitList) + Newline);
for Index := FRunTimeProcList.count - 1 downto 0 do
begin
@ -754,6 +778,8 @@ begin
// OutPutList.Add('{$I PascalScript.inc}');
OutPutList.Add('interface');
OutPutList.Add(' ');
OutPutList.Add(FAfterInterfaceDeclaration);
OutPutList.Add(' ');
{ interface uses clause list }
AddToUsesList(InterfaceUsesList, nil, 'SysUtils');
@ -779,7 +805,7 @@ begin
OutPutList.Add('type ');
OutPutList.Add('(*----------------------------------------------------------------------------*)');
OutPutList.Add(Format(' %s = class(TPSPlugin)', [sClassName]));
OutPutList.Add(' protected');
OutPutList.Add(' public');
// OutPutList.Add(' procedure CompOnUses(CompExec: TPSScript); override;');
// OutPutList.Add(' procedure ExecOnUses(CompExec: TPSScript); override;');
OutPutList.Add(' procedure CompileImport1(CompExec: TPSScript); override;');
@ -942,10 +968,15 @@ begin
OutPutList.Add('(*----------------------------------------------------------------------------*)');
OutPutList.Add(Format('procedure %s.ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter);', [sClassName]));
OutPutList.Add('begin');
if not (InterfaceImporter in RunTimeProcType) then //Birb
OutPutList.Add(Format(' RIRegister_%s(ri);', [UnitName])); //Birb: (!!!) should fix it so that this line is never added if there's no RIRegister... routine (e.g. if unit has just constants)
// Birb: (!!!) should fix it so that this line is never added if there's
// no RIRegister...routine (e.g. if unit has just constants)
if (ClassImporter in RunTimeProcType) then
OutPutList.Add(Format(' RIRegister_%s(ri);', [UnitName]));
if RoutineImporter in RunTimeProcType then
OutPutList.Add(Format(' RIRegister_%s_Routines(CompExec.Exec); // comment it if no routines', [UnitName]));
OutPutList.Add('end;');
OutPutList.Add('(*----------------------------------------------------------------------------*)');
@ -1517,13 +1548,19 @@ begin
OldProcName := ProcName;
Olddecl := decl;
s := '';
ProcName := OldProcName + InttoStr(FRenamingHelper);
Inc(FRenamingHelper);
repeat
Readln(ProcName, s+'Current declaration :' + '''' + OwnerClass +decl + '''', 'Enter new name.');
if FAutoRenameOverloadedMethods then
Writeln('Auto-remapped')
else
Readln(ProcName, s+'Current declaration :' + '''' + OwnerClass +decl + '''', 'Enter new name.');
if ProcName = '' then
ProcName := OldProcName;
// create a tmp procedure to handle the overload (self:
decl2 := decl; // jgv someone forget it !!!
// create a tmp procedure to handle the overload.
decl2 := decl;
If (IsMethod in Options) then
if (Pos('(',decl)=0)then
@ -1545,7 +1582,7 @@ begin
if {not} (IsDone in Proc.ProcAttr) then
begin
If S = '' then
S := 'Procedure name has been used, entre a new one'^m;
S := 'Procedure name has been used, enter a new one'^m;
ProcName := OldProcName;
decl := Olddecl;
end
@ -1623,9 +1660,9 @@ var
Exit;
if isInterface then //Birb
fCurrentDTProc.Add(' RegisterMethod(''' + decl + ''', '+callingConvention+');')
fCurrentDTProc.Add(' RegisterMethod(''' + SplitIntoLines(decl) + ''', '+callingConvention+');')
else
fCurrentDTProc.Add(' RegisterMethod(''' + decl + ''');');
fCurrentDTProc.Add(' RegisterMethod(''' + SplitIntoLines(decl) + ''');');
if IsCallHelper in ProcDeclInfo then
PProcName := aClassname + ProcName+'_P'