david
397cad2594
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@2 b6239004-a887-0f4b-9937-50029ccdca16
411 lines
9.8 KiB
ObjectPascal
411 lines
9.8 KiB
ObjectPascal
unit ide_editor;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
|
Dialogs, SynEdit, SynEditHighlighter, SynHighlighterPas,
|
|
Menus, uPSCompiler, uPSRuntime, uPSDisassembly, uPSUtils, ExtCtrls,
|
|
StdCtrls, ComCtrls, uPSComponent_COM, uPSComponent_StdCtrls,
|
|
uPSComponent_Forms, uPSComponent_Default, uPSComponent_Controls, uPSComponent,
|
|
uPSDebugger;
|
|
|
|
type
|
|
Teditor = class(TForm)
|
|
ce: TPSScriptDebugger;
|
|
IFPS3DllPlugin1: TPSDllPlugin;
|
|
pashighlighter: TSynPasSyn;
|
|
ed: TSynEdit;
|
|
PopupMenu1: TPopupMenu;
|
|
BreakPointMenu: TMenuItem;
|
|
MainMenu1: TMainMenu;
|
|
File1: TMenuItem;
|
|
Run1: TMenuItem;
|
|
StepOver1: TMenuItem;
|
|
StepInto1: TMenuItem;
|
|
N1: TMenuItem;
|
|
Reset1: TMenuItem;
|
|
N2: TMenuItem;
|
|
Run2: TMenuItem;
|
|
Exit1: TMenuItem;
|
|
messages: TListBox;
|
|
Splitter1: TSplitter;
|
|
SaveDialog1: TSaveDialog;
|
|
OpenDialog1: TOpenDialog;
|
|
N3: TMenuItem;
|
|
N4: TMenuItem;
|
|
New1: TMenuItem;
|
|
Open1: TMenuItem;
|
|
Save1: TMenuItem;
|
|
Saveas1: TMenuItem;
|
|
StatusBar1: TStatusBar;
|
|
Decompile1: TMenuItem;
|
|
N5: TMenuItem;
|
|
IFPS3CE_Controls1: TPSImport_Controls;
|
|
IFPS3CE_DateUtils1: TPSImport_DateUtils;
|
|
IFPS3CE_Std1: TPSImport_Classes;
|
|
IFPS3CE_Forms1: TPSImport_Forms;
|
|
IFPS3CE_StdCtrls1: TPSImport_StdCtrls;
|
|
IFPS3CE_ComObj1: TPSImport_ComObj;
|
|
procedure edSpecialLineColors(Sender: TObject; Line: Integer;
|
|
var Special: Boolean; var FG, BG: TColor);
|
|
procedure BreakPointMenuClick(Sender: TObject);
|
|
procedure ceLineInfo(Sender: TObject; const FileName: String; Position, Row, Col: Cardinal);
|
|
procedure Exit1Click(Sender: TObject);
|
|
procedure StepOver1Click(Sender: TObject);
|
|
procedure StepInto1Click(Sender: TObject);
|
|
procedure Reset1Click(Sender: TObject);
|
|
procedure ceIdle(Sender: TObject);
|
|
procedure Run2Click(Sender: TObject);
|
|
procedure ceExecute(Sender: TPSScript);
|
|
procedure ceAfterExecute(Sender: TPSScript);
|
|
procedure ceCompile(Sender: TPSScript);
|
|
procedure New1Click(Sender: TObject);
|
|
procedure Open1Click(Sender: TObject);
|
|
procedure Save1Click(Sender: TObject);
|
|
procedure Saveas1Click(Sender: TObject);
|
|
procedure edStatusChange(Sender: TObject; Changes: TSynStatusChanges);
|
|
procedure Decompile1Click(Sender: TObject);
|
|
function ceNeedFile(Sender: TObject; const OrginFileName: String;
|
|
var FileName, Output: String): Boolean;
|
|
procedure ceBreakpoint(Sender: TObject; const FileName: String; Position, Row, Col: Cardinal);
|
|
procedure FormClick(Sender: TObject);
|
|
private
|
|
FActiveLine: Longint;
|
|
FResume: Boolean;
|
|
FActiveFile: string;
|
|
function Compile: Boolean;
|
|
function Execute: Boolean;
|
|
|
|
procedure Writeln(const s: string);
|
|
procedure Readln(var s: string);
|
|
procedure SetActiveFile(const Value: string);
|
|
|
|
property aFile: string read FActiveFile write SetActiveFile;
|
|
public
|
|
function SaveCheck: Boolean;
|
|
end;
|
|
|
|
var
|
|
editor: Teditor;
|
|
|
|
implementation
|
|
|
|
uses ide_debugoutput;
|
|
|
|
{$R *.dfm}
|
|
|
|
procedure Teditor.edSpecialLineColors(Sender: TObject; Line: Integer;
|
|
var Special: Boolean; var FG, BG: TColor);
|
|
begin
|
|
if ce.HasBreakPoint(ce.MainFileName, Line) then
|
|
begin
|
|
Special := True;
|
|
if Line = FActiveLine then
|
|
begin
|
|
BG := clWhite;
|
|
FG := clRed;
|
|
end else
|
|
begin
|
|
FG := clWhite;
|
|
BG := clRed;
|
|
end;
|
|
end else
|
|
if Line = FActiveLine then
|
|
begin
|
|
Special := True;
|
|
FG := clWhite;
|
|
bg := clBlue;
|
|
end else Special := False;
|
|
end;
|
|
|
|
procedure Teditor.BreakPointMenuClick(Sender: TObject);
|
|
var
|
|
Line: Longint;
|
|
begin
|
|
Line := Ed.CaretY;
|
|
if ce.HasBreakPoint(ce.MainFileName, Line) then
|
|
ce.ClearBreakPoint(ce.MainFileName, Line)
|
|
else
|
|
ce.SetBreakPoint(ce.MainFileName, Line);
|
|
ed.Refresh;
|
|
end;
|
|
|
|
procedure Teditor.ceLineInfo(Sender: TObject; const FileName: String; Position, Row,
|
|
Col: Cardinal);
|
|
begin
|
|
if ce.Exec.DebugMode <> dmRun then
|
|
begin
|
|
FActiveLine := Row;
|
|
if (FActiveLine < ed.TopLine +2) or (FActiveLine > Ed.TopLine + Ed.LinesInWindow -2) then
|
|
begin
|
|
Ed.TopLine := FActiveLine - (Ed.LinesInWindow div 2);
|
|
end;
|
|
ed.CaretY := FActiveLine;
|
|
ed.CaretX := 1;
|
|
|
|
ed.Refresh;
|
|
end;
|
|
end;
|
|
|
|
procedure Teditor.Exit1Click(Sender: TObject);
|
|
begin
|
|
Close;
|
|
end;
|
|
|
|
procedure Teditor.StepOver1Click(Sender: TObject);
|
|
begin
|
|
if ce.Exec.Status = isRunning then
|
|
ce.StepOver
|
|
else
|
|
begin
|
|
if Compile then
|
|
begin
|
|
ce.StepInto;
|
|
Execute;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure Teditor.StepInto1Click(Sender: TObject);
|
|
begin
|
|
if ce.Exec.Status = isRunning then
|
|
ce.StepInto
|
|
else
|
|
begin
|
|
if Compile then
|
|
begin
|
|
ce.StepInto;
|
|
Execute;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure Teditor.Reset1Click(Sender: TObject);
|
|
begin
|
|
if ce.Exec.Status = isRunning then
|
|
ce.Stop;
|
|
end;
|
|
|
|
function Teditor.Compile: Boolean;
|
|
var
|
|
i: Longint;
|
|
begin
|
|
ce.Script.Assign(ed.Lines);
|
|
Result := ce.Compile;
|
|
messages.Clear;
|
|
for i := 0 to ce.CompilerMessageCount -1 do
|
|
begin
|
|
Messages.Items.Add(ce.CompilerMessages[i].MessageToString);
|
|
end;
|
|
if Result then
|
|
Messages.Items.Add('Succesfully compiled');
|
|
end;
|
|
|
|
procedure Teditor.ceIdle(Sender: TObject);
|
|
begin
|
|
Application.HandleMessage;
|
|
if FResume then
|
|
begin
|
|
FResume := False;
|
|
ce.Resume;
|
|
FActiveLine := 0;
|
|
ed.Refresh;
|
|
end;
|
|
end;
|
|
|
|
procedure Teditor.Run2Click(Sender: TObject);
|
|
begin
|
|
if CE.Running then
|
|
begin
|
|
FResume := True
|
|
end else
|
|
begin
|
|
if Compile then
|
|
Execute;
|
|
end;
|
|
end;
|
|
|
|
procedure Teditor.ceExecute(Sender: TPSScript);
|
|
begin
|
|
ce.SetVarToInstance('SELF', Self);
|
|
ce.SetVarToInstance('APPLICATION', Application);
|
|
Caption := 'Editor - Running';
|
|
end;
|
|
|
|
procedure Teditor.ceAfterExecute(Sender: TPSScript);
|
|
begin
|
|
Caption := 'Editor';
|
|
FActiveLine := 0;
|
|
ed.Refresh;
|
|
end;
|
|
|
|
function Teditor.Execute: Boolean;
|
|
begin
|
|
debugoutput.Output.Clear;
|
|
if CE.Execute then
|
|
begin
|
|
Messages.Items.Add('Succesfully Execute');
|
|
Result := True;
|
|
end else
|
|
begin
|
|
messages.Items.Add('Runtime Error: '+ce.ExecErrorToString + ' at ['+IntToStr(ce.ExecErrorRow)+':'+IntToStr(ce.ExecErrorCol)+'] bytecode pos:'+inttostr(ce.ExecErrorProcNo)+':'+inttostr(ce.ExecErrorByteCodePosition));
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
procedure Teditor.Writeln(const s: string);
|
|
begin
|
|
debugoutput.output.Lines.Add(S);
|
|
debugoutput.Visible := True;
|
|
end;
|
|
|
|
procedure Teditor.ceCompile(Sender: TPSScript);
|
|
begin
|
|
Sender.AddMethod(Self, @TEditor.Writeln, 'procedure Writeln(s: string)');
|
|
Sender.AddMethod(Self, @TEditor.Readln, 'procedure readln(var s: string)');
|
|
Sender.AddRegisteredVariable('Self', 'TForm');
|
|
Sender.AddRegisteredVariable('Application', 'TApplication');
|
|
end;
|
|
|
|
procedure Teditor.Readln(var s: string);
|
|
begin
|
|
s := InputBox('Script', '', '');
|
|
end;
|
|
|
|
procedure Teditor.New1Click(Sender: TObject);
|
|
begin
|
|
if SaveCheck then
|
|
begin
|
|
ed.ClearAll;
|
|
ed.Lines.Text := 'Program test;'#13#10'begin'#13#10'end.';
|
|
ed.Modified := False;
|
|
aFile := '';
|
|
end;
|
|
end;
|
|
|
|
procedure Teditor.Open1Click(Sender: TObject);
|
|
begin
|
|
if SaveCheck then
|
|
begin
|
|
if OpenDialog1.Execute then
|
|
begin
|
|
ed.ClearAll;
|
|
ed.Lines.LoadFromFile(OpenDialog1.FileName);
|
|
ed.Modified := False;
|
|
aFile := OpenDialog1.FileName;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure Teditor.Save1Click(Sender: TObject);
|
|
begin
|
|
if aFile <> '' then
|
|
begin
|
|
ed.Lines.SaveToFile(aFile);
|
|
ed.Modified := False;
|
|
end else
|
|
SaveAs1Click(nil);
|
|
end;
|
|
|
|
procedure Teditor.Saveas1Click(Sender: TObject);
|
|
begin
|
|
if SaveDialog1.Execute then
|
|
begin
|
|
aFile := SaveDialog1.FileName;
|
|
ed.Lines.SaveToFile(aFile);
|
|
ed.Modified := False;
|
|
end;
|
|
end;
|
|
|
|
function Teditor.SaveCheck: Boolean;
|
|
begin
|
|
if ed.Modified then
|
|
begin
|
|
case MessageDlg('File has not been saved, save now?', mtConfirmation, mbYesNoCancel, 0) of
|
|
idYes:
|
|
begin
|
|
Save1Click(nil);
|
|
Result := aFile <> '';
|
|
end;
|
|
IDNO: Result := True;
|
|
else
|
|
Result := False;
|
|
end;
|
|
end else Result := True;
|
|
end;
|
|
|
|
procedure Teditor.edStatusChange(Sender: TObject;
|
|
Changes: TSynStatusChanges);
|
|
begin
|
|
StatusBar1.Panels[0].Text := IntToStr(ed.CaretY)+':'+IntToStr(ed.CaretX)
|
|
end;
|
|
|
|
procedure Teditor.Decompile1Click(Sender: TObject);
|
|
var
|
|
s: string;
|
|
begin
|
|
if Compile then
|
|
begin
|
|
ce.GetCompiled(s);
|
|
IFPS3DataToText(s, s);
|
|
debugoutput.output.Lines.Text := s;
|
|
debugoutput.visible := true;
|
|
end;
|
|
end;
|
|
|
|
function Teditor.ceNeedFile(Sender: TObject; const OrginFileName: String;
|
|
var FileName, Output: String): Boolean;
|
|
var
|
|
path: string;
|
|
f: TFileStream;
|
|
begin
|
|
if aFile <> '' then
|
|
Path := ExtractFilePath(aFile)
|
|
else
|
|
Path := ExtractFilePath(ParamStr(0));
|
|
Path := Path + FileName;
|
|
try
|
|
F := TFileStream.Create(Path, fmOpenRead or fmShareDenyWrite);
|
|
except
|
|
Result := false;
|
|
exit;
|
|
end;
|
|
try
|
|
SetLength(Output, f.Size);
|
|
f.Read(Output[1], Length(Output));
|
|
finally
|
|
f.Free;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure Teditor.ceBreakpoint(Sender: TObject; const FileName: String; Position, Row,
|
|
Col: Cardinal);
|
|
begin
|
|
FActiveLine := Row;
|
|
if (FActiveLine < ed.TopLine +2) or (FActiveLine > Ed.TopLine + Ed.LinesInWindow -2) then
|
|
begin
|
|
Ed.TopLine := FActiveLine - (Ed.LinesInWindow div 2);
|
|
end;
|
|
ed.CaretY := FActiveLine;
|
|
ed.CaretX := 1;
|
|
|
|
ed.Refresh;
|
|
end;
|
|
|
|
procedure Teditor.SetActiveFile(const Value: string);
|
|
begin
|
|
FActiveFile := Value;
|
|
ce.MainFileName := ExtractFileName(FActiveFile);
|
|
if Ce.MainFileName = '' then
|
|
Ce.MainFileName := 'Unnamed';
|
|
end;
|
|
|
|
procedure Teditor.FormClick(Sender: TObject);
|
|
begin
|
|
ShowMessage('BLA');
|
|
end;
|
|
|
|
end.
|