mirror of https://gitlab.com/basile.b/dexed.git
#97, refactor dbg, use interfaces + the entity connector
This commit is contained in:
parent
1a97a709c3
commit
92008c3a09
Binary file not shown.
After Width: | Height: | Size: 494 B |
Binary file not shown.
After Width: | Height: | Size: 415 B |
Binary file not shown.
After Width: | Height: | Size: 302 B |
|
@ -13,7 +13,7 @@
|
||||||
<DpiAware Value="True"/>
|
<DpiAware Value="True"/>
|
||||||
</XPManifest>
|
</XPManifest>
|
||||||
<Icon Value="0"/>
|
<Icon Value="0"/>
|
||||||
<Resources Count="94">
|
<Resources Count="97">
|
||||||
<Resource_0 FileName="../icons/window/layout_add.png" Type="RCDATA" ResourceName="LAYOUT_ADD"/>
|
<Resource_0 FileName="../icons/window/layout_add.png" Type="RCDATA" ResourceName="LAYOUT_ADD"/>
|
||||||
<Resource_1 FileName="../icons/window/layout.png" Type="RCDATA" ResourceName="LAYOUT"/>
|
<Resource_1 FileName="../icons/window/layout.png" Type="RCDATA" ResourceName="LAYOUT"/>
|
||||||
<Resource_2 FileName="../icons/window/application_go.png" Type="RCDATA" ResourceName="APPLICATION_GO"/>
|
<Resource_2 FileName="../icons/window/application_go.png" Type="RCDATA" ResourceName="APPLICATION_GO"/>
|
||||||
|
@ -108,6 +108,9 @@
|
||||||
<Resource_91 FileName="../icons/other/pause.png" Type="RCDATA" ResourceName="PAUSE"/>
|
<Resource_91 FileName="../icons/other/pause.png" Type="RCDATA" ResourceName="PAUSE"/>
|
||||||
<Resource_92 FileName="../icons/other/play.png" Type="RCDATA" ResourceName="PLAY"/>
|
<Resource_92 FileName="../icons/other/play.png" Type="RCDATA" ResourceName="PLAY"/>
|
||||||
<Resource_93 FileName="../icons/other/power.png" Type="RCDATA" ResourceName="POWER"/>
|
<Resource_93 FileName="../icons/other/power.png" Type="RCDATA" ResourceName="POWER"/>
|
||||||
|
<Resource_94 FileName="../icons/other/stop.png" Type="RCDATA" ResourceName="STOP"/>
|
||||||
|
<Resource_95 FileName="../icons/other/breaks.png" Type="RCDATA" ResourceName="BREAKS"/>
|
||||||
|
<Resource_96 FileName="../icons/other/step.png" Type="RCDATA" ResourceName="STEP"/>
|
||||||
</Resources>
|
</Resources>
|
||||||
</General>
|
</General>
|
||||||
<i18n>
|
<i18n>
|
||||||
|
@ -236,7 +239,7 @@
|
||||||
<PackageName Value="LCL"/>
|
<PackageName Value="LCL"/>
|
||||||
</Item7>
|
</Item7>
|
||||||
</RequiredPackages>
|
</RequiredPackages>
|
||||||
<Units Count="52">
|
<Units Count="53">
|
||||||
<Unit0>
|
<Unit0>
|
||||||
<Filename Value="coedit.lpr"/>
|
<Filename Value="coedit.lpr"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
|
@ -506,6 +509,10 @@
|
||||||
<Filename Value="..\src\ce_dastworx.pas"/>
|
<Filename Value="..\src\ce_dastworx.pas"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
</Unit51>
|
</Unit51>
|
||||||
|
<Unit52>
|
||||||
|
<Filename Value="..\src\ce_dbgitf.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit52>
|
||||||
</Units>
|
</Units>
|
||||||
</ProjectOptions>
|
</ProjectOptions>
|
||||||
<CompilerOptions>
|
<CompilerOptions>
|
||||||
|
|
|
@ -12,7 +12,7 @@ uses
|
||||||
ce_dockoptions, ce_shortcutseditor, ce_mru, ce_processes, ce_dubproject,
|
ce_dockoptions, ce_shortcutseditor, ce_mru, ce_processes, ce_dubproject,
|
||||||
ce_dialogs, ce_dubprojeditor, ce_controls, ce_dfmt, ce_lcldragdrop,
|
ce_dialogs, ce_dubprojeditor, ce_controls, ce_dfmt, ce_lcldragdrop,
|
||||||
ce_stringrange, ce_dlangmaps, ce_projgroup, ce_projutils, ce_d2synpresets,
|
ce_stringrange, ce_dlangmaps, ce_projgroup, ce_projutils, ce_d2synpresets,
|
||||||
ce_dastworx;
|
ce_dastworx, ce_dbgitf;
|
||||||
|
|
||||||
{$R *.res}
|
{$R *.res}
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,90 @@
|
||||||
|
unit ce_dbgitf;
|
||||||
|
|
||||||
|
{$I ce_defines.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, ce_observer;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
TBreakPointKind = (
|
||||||
|
bpkBreak, // break
|
||||||
|
bpkTrace // a message is output
|
||||||
|
);
|
||||||
|
|
||||||
|
(**
|
||||||
|
* ICEEDebugObserver can call any of the method during debugging
|
||||||
|
*)
|
||||||
|
ICEDebugger = interface
|
||||||
|
procedure addBreakPoint(const fname: string; line: integer; kind: TBreakPointKind);
|
||||||
|
procedure removeBreakPoint(const fname: string; line: integer);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Enumerates th e reason why debuging breaks.
|
||||||
|
TCEDebugBreakReason = (
|
||||||
|
dbUnknown, // ?
|
||||||
|
dbBreakPoint, // a break point is reached.
|
||||||
|
dbSignal, // an unexpected signal is emitted.
|
||||||
|
dbStep // step to this line
|
||||||
|
);
|
||||||
|
(**
|
||||||
|
* An implementer is informed about a debuging session.
|
||||||
|
*)
|
||||||
|
ICEDebugObserver = interface(IObserverType)
|
||||||
|
['ICEDebugObserver']
|
||||||
|
// a debugging session starts. The ICEDebugger can be stored for the session.
|
||||||
|
procedure debugStart(debugger: ICEDebugger);
|
||||||
|
// a debugging session terminates. Any pointer to a ICEDebugger becomes invalid.
|
||||||
|
procedure debugStop;
|
||||||
|
// the debuger wants to know how many times debugQueryBreakPoints must be called.
|
||||||
|
function debugQueryBpCount: integer;
|
||||||
|
// the debuger wants breakpoints.
|
||||||
|
procedure debugQueryBreakPoint(const index: integer; out fname: string;
|
||||||
|
out line: integer; out kind: TBreakPointKind);
|
||||||
|
// a break happens when code in fname at line is executed.
|
||||||
|
procedure debugBreak(const fname: string; line: integer; reason: TCEDebugBreakReason);
|
||||||
|
end;
|
||||||
|
|
||||||
|
(**
|
||||||
|
* An implementer notifies is observer about a debuginf session.
|
||||||
|
*)
|
||||||
|
TCEDebugObserverSubject = specialize TCECustomSubject<ICEDebugObserver>;
|
||||||
|
|
||||||
|
// TCEDebugObserverSubject primitives
|
||||||
|
procedure subjDebugStart(subj: TCEDebugObserverSubject; dbg: ICEDebugger);
|
||||||
|
procedure subjDebugStop(subj: TCEDebugObserverSubject);
|
||||||
|
procedure subjDebugBreak(subj: TCEDebugObserverSubject; const fname: string;
|
||||||
|
line: integer; reason: TCEDebugBreakReason);
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure subjDebugStart(subj: TCEDebugObserverSubject; dbg: ICEDebugger);
|
||||||
|
var
|
||||||
|
i: integer;
|
||||||
|
begin
|
||||||
|
for i:= 0 to subj.observersCount-1 do
|
||||||
|
(subj.observers[i] as ICEDebugObserver).debugStart(dbg);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure subjDebugStop(subj: TCEDebugObserverSubject);
|
||||||
|
var
|
||||||
|
i: integer;
|
||||||
|
begin
|
||||||
|
for i:= 0 to subj.observersCount-1 do
|
||||||
|
(subj.observers[i] as ICEDebugObserver).debugStop;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure subjDebugBreak(subj: TCEDebugObserverSubject; const fname: string;
|
||||||
|
line: integer; reason: TCEDebugBreakReason);
|
||||||
|
var
|
||||||
|
i: integer;
|
||||||
|
begin
|
||||||
|
for i:= 0 to subj.observersCount-1 do
|
||||||
|
(subj.observers[i] as ICEDebugObserver).debugBreak(fname, line, reason);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
|
@ -142,7 +142,7 @@ inherited CEGdbWidget: TCEGdbWidget
|
||||||
Top = 0
|
Top = 0
|
||||||
Caption = 'btnStop'
|
Caption = 'btnStop'
|
||||||
OnClick = btnStopClick
|
OnClick = btnStopClick
|
||||||
resourceName = 'CANCEL'
|
resourceName = 'STOP'
|
||||||
scaledSeparator = False
|
scaledSeparator = False
|
||||||
end
|
end
|
||||||
object btnContinue: TCEToolButton[7]
|
object btnContinue: TCEToolButton[7]
|
||||||
|
|
114
src/ce_gdb.pas
114
src/ce_gdb.pas
|
@ -5,11 +5,11 @@ unit ce_gdb;
|
||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, FileUtil, ListFilterEdit, Forms, Controls, Graphics,
|
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, RegExpr, ComCtrls,
|
||||||
RegExpr, ComCtrls, PropEdits, GraphPropEdits, RTTIGrids, Dialogs, ExtCtrls,
|
PropEdits, GraphPropEdits, RTTIGrids, Dialogs, ExtCtrls, Menus, Buttons,
|
||||||
Menus, strutils, Buttons, StdCtrls, process, fpjson,
|
StdCtrls, process, fpjson,
|
||||||
ce_common, ce_interfaces, ce_widget, ce_processes, ce_observer, ce_synmemo,
|
ce_common, ce_interfaces, ce_widget, ce_processes, ce_observer, ce_synmemo,
|
||||||
ce_sharedres, ce_stringrange, ce_dsgncontrols, ce_dialogs;
|
ce_sharedres, ce_stringrange, ce_dsgncontrols, ce_dialogs, ce_dbgitf;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
|
@ -211,7 +211,7 @@ type
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TCEGdbWidget }
|
{ TCEGdbWidget }
|
||||||
TCEGdbWidget = class(TCEWidget, ICEProjectObserver, ICEDocumentObserver)
|
TCEGdbWidget = class(TCEWidget, ICEProjectObserver, ICEDocumentObserver, ICEDebugger)
|
||||||
btnContinue: TCEToolButton;
|
btnContinue: TCEToolButton;
|
||||||
btnPause: TCEToolButton;
|
btnPause: TCEToolButton;
|
||||||
btnReg: TCEToolButton;
|
btnReg: TCEToolButton;
|
||||||
|
@ -237,6 +237,7 @@ type
|
||||||
protected
|
protected
|
||||||
procedure setToolBarFlat(value: boolean); override;
|
procedure setToolBarFlat(value: boolean); override;
|
||||||
private
|
private
|
||||||
|
fSubj: TCEDebugObserverSubject;
|
||||||
fDoc: TCESynMemo;
|
fDoc: TCESynMemo;
|
||||||
fProj: ICECommonProject;
|
fProj: ICECommonProject;
|
||||||
fJson: TJsonObject;
|
fJson: TJsonObject;
|
||||||
|
@ -251,8 +252,7 @@ type
|
||||||
//
|
//
|
||||||
procedure startDebugging;
|
procedure startDebugging;
|
||||||
procedure killGdb;
|
procedure killGdb;
|
||||||
procedure updateFileLineBrks;
|
procedure storeObserversBreakpoints;
|
||||||
procedure editorModBrk(sender: TCESynMemo; line: integer; modification: TBreakPointModification);
|
|
||||||
// GDB output processors
|
// GDB output processors
|
||||||
procedure gdboutQuiet(sender: TObject);
|
procedure gdboutQuiet(sender: TObject);
|
||||||
procedure gdboutJsonize(sender: TObject);
|
procedure gdboutJsonize(sender: TObject);
|
||||||
|
@ -273,6 +273,9 @@ type
|
||||||
procedure docFocused(document: TCESynMemo);
|
procedure docFocused(document: TCESynMemo);
|
||||||
procedure docChanged(document: TCESynMemo);
|
procedure docChanged(document: TCESynMemo);
|
||||||
procedure docClosing(document: TCESynMemo);
|
procedure docClosing(document: TCESynMemo);
|
||||||
|
//
|
||||||
|
procedure addBreakPoint(const fname: string; line: integer; kind: TBreakPointKind);
|
||||||
|
procedure removeBreakPoint(const fname: string; line: integer);
|
||||||
public
|
public
|
||||||
constructor create(aOwner: TComponent); override;
|
constructor create(aOwner: TComponent); override;
|
||||||
destructor destroy; override;
|
destructor destroy; override;
|
||||||
|
@ -413,6 +416,7 @@ begin
|
||||||
stateViewer.TIObject := fInspState;
|
stateViewer.TIObject := fInspState;
|
||||||
fJson := TJsonObject.Create;
|
fJson := TJsonObject.Create;
|
||||||
fStackItems := TStackItems.create;
|
fStackItems := TStackItems.create;
|
||||||
|
fSubj:= TCEDebugObserverSubject.Create;
|
||||||
fShowCLI := true;
|
fShowCLI := true;
|
||||||
//
|
//
|
||||||
AssignPng(btnSendCom, 'ACCEPT');
|
AssignPng(btnSendCom, 'ACCEPT');
|
||||||
|
@ -427,6 +431,7 @@ begin
|
||||||
fJson.Free;
|
fJson.Free;
|
||||||
fStackItems.Free;
|
fStackItems.Free;
|
||||||
EntitiesConnector.removeObserver(self);
|
EntitiesConnector.removeObserver(self);
|
||||||
|
fSubj.free;
|
||||||
inherited;
|
inherited;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -473,14 +478,10 @@ end;
|
||||||
{$REGION ICEDocumentObserver ---------------------------------------------------}
|
{$REGION ICEDocumentObserver ---------------------------------------------------}
|
||||||
procedure TCEGdbWidget.docNew(document: TCESynMemo);
|
procedure TCEGdbWidget.docNew(document: TCESynMemo);
|
||||||
begin
|
begin
|
||||||
if document.isDSource then
|
|
||||||
document.onBreakpointModify := @editorModBrk;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCEGdbWidget.docFocused(document: TCESynMemo);
|
procedure TCEGdbWidget.docFocused(document: TCESynMemo);
|
||||||
begin
|
begin
|
||||||
if document.isDSource then
|
|
||||||
document.onBreakpointModify := @editorModBrk;
|
|
||||||
fDoc := document;
|
fDoc := document;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -505,49 +506,41 @@ begin
|
||||||
FreeAndNil(fGdb);
|
FreeAndNil(fGdb);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCEGdbWidget.updateFileLineBrks;
|
procedure TCEGdbWidget.storeObserversBreakpoints;
|
||||||
var
|
var
|
||||||
i,j: integer;
|
i,j: integer;
|
||||||
doc: TCESynMemo;
|
obs: ICEDebugObserver;
|
||||||
nme: string;
|
nme: string;
|
||||||
|
lne: integer;
|
||||||
|
knd: TBreakPointKind;
|
||||||
begin
|
begin
|
||||||
fFileLineBrks.Clear;
|
fFileLineBrks.Clear;
|
||||||
if fDocHandler = nil then exit;
|
for i:= 0 to fSubj.observersCount-1 do
|
||||||
//
|
|
||||||
for i:= 0 to fDocHandler.documentCount-1 do
|
|
||||||
begin
|
begin
|
||||||
doc := fDocHandler.document[i];
|
obs := fSubj.observers[i] as ICEDebugObserver;
|
||||||
if not doc.isDSource then
|
for j := 0 to obs.debugQueryBpCount-1 do
|
||||||
continue;
|
begin
|
||||||
nme := doc.fileName;
|
obs.debugQueryBreakPoint(j, nme, lne, knd);
|
||||||
if not nme.fileExists then
|
{$PUSH}{$WARNINGS OFF}{$HINTS OFF}
|
||||||
continue;
|
fFileLineBrks.AddObject(nme, TObject(pointer(lne)));
|
||||||
{$PUSH}{$WARNINGS OFF}{$HINTS OFF}
|
{$POP}
|
||||||
for j := 0 to doc.breakPointsCount-1 do
|
end;
|
||||||
fFileLineBrks.AddObject(nme, TObject(pointer(doc.BreakPointLine(j))));
|
|
||||||
{$POP}
|
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCEGdbWidget.editorModBrk(sender: TCESynMemo; line: integer; modification: TBreakPointModification);
|
procedure TCEGdbWidget.addBreakPoint(const fname: string; line: integer; kind: TBreakPointKind);
|
||||||
var
|
|
||||||
str: string;
|
|
||||||
nme: string;
|
|
||||||
const
|
|
||||||
cmd: array[TBreakPointModification] of string = ('break ', 'clear ');
|
|
||||||
begin
|
begin
|
||||||
// set only breakpoint in live, while debugging
|
if fGdb.isNil or not fGdb.Running then
|
||||||
// note: only works if execution is paused (breakpoint)
|
exit;
|
||||||
// and not inside a loop (for ex. with sleep).
|
//TODO-cGDB: handle trace points
|
||||||
if fGdb = nil then exit;
|
gdbCommand('break ' + fname + ':' + intToStr(line));
|
||||||
if not fGdb.Running then exit;
|
end;
|
||||||
nme := sender.fileName;
|
|
||||||
if not nme.fileExists then exit;
|
procedure TCEGdbWidget.removeBreakPoint(const fname: string; line: integer);
|
||||||
//
|
begin
|
||||||
str := cmd[modification] + nme + ':' + intToStr(line);
|
if fGdb.isNil or not fGdb.Running then
|
||||||
fGdb.Suspend;
|
exit;
|
||||||
gdbCommand(str);
|
gdbCommand('clear ' + fname + ':' + intToStr(line));
|
||||||
fGdb.Resume;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCEGdbWidget.startDebugging;
|
procedure TCEGdbWidget.startDebugging;
|
||||||
|
@ -556,10 +549,15 @@ var
|
||||||
i: integer;
|
i: integer;
|
||||||
begin
|
begin
|
||||||
// protect
|
// protect
|
||||||
if fProj = nil then exit;
|
if fProj = nil then
|
||||||
if fProj.binaryKind <> executable then exit;
|
exit;
|
||||||
|
if fProj.binaryKind <> executable then
|
||||||
|
exit;
|
||||||
str := fProj.outputFilename;
|
str := fProj.outputFilename;
|
||||||
if not str.fileExists then exit;
|
if not str.fileExists then
|
||||||
|
exit;
|
||||||
|
// TODO-cDBG: detect finish event and notifiy the observers.
|
||||||
|
subjDebugStart(fSubj, self as ICEDebugger);
|
||||||
// gdb process
|
// gdb process
|
||||||
killGdb;
|
killGdb;
|
||||||
fGdb := TCEProcess.create(nil);
|
fGdb := TCEProcess.create(nil);
|
||||||
|
@ -571,14 +569,13 @@ begin
|
||||||
fGdb.OnTerminate:= @gdboutQuiet;
|
fGdb.OnTerminate:= @gdboutQuiet;
|
||||||
fgdb.execute;
|
fgdb.execute;
|
||||||
// file:line breakpoints
|
// file:line breakpoints
|
||||||
updateFileLineBrks;
|
storeObserversBreakpoints;
|
||||||
for i:= 0 to fFileLineBrks.Count-1 do
|
for i:= 0 to fFileLineBrks.Count-1 do
|
||||||
begin
|
begin
|
||||||
str := 'break ' + fFileLineBrks.Strings[i] + ':' + intToStr(PtrUInt(fFileLineBrks.Objects[i])) + #10;
|
str := 'break ' + fFileLineBrks.Strings[i] + ':' + intToStr(PtrUInt(fFileLineBrks.Objects[i])) + #10;
|
||||||
fGdb.Input.Write(str[1], str.length);
|
fGdb.Input.Write(str[1], str.length);
|
||||||
end;
|
end;
|
||||||
// break on druntime exceptions + any throw'
|
// break on druntime exceptions + any throw'
|
||||||
fGdb.OnReadData := @gdboutQuiet;
|
|
||||||
gdbCommand('break onAssertError');
|
gdbCommand('break onAssertError');
|
||||||
gdbCommand('break onAssertErrorMsg');
|
gdbCommand('break onAssertErrorMsg');
|
||||||
gdbCommand('break onUnittestErrorMsg');
|
gdbCommand('break onUnittestErrorMsg');
|
||||||
|
@ -804,11 +801,7 @@ begin
|
||||||
if val.isNotNil then
|
if val.isNotNil then
|
||||||
line := strToInt(val.AsString);
|
line := strToInt(val.AsString);
|
||||||
if (line <> -1) and fullname.fileExists then
|
if (line <> -1) and fullname.fileExists then
|
||||||
begin
|
subjDebugBreak(fSubj, fullname, line, dbBreakPoint);
|
||||||
getMultiDocHandler.openDocument(fullname);
|
|
||||||
fDoc.setFocus;
|
|
||||||
fDoc.CaretY:= line;
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -837,15 +830,8 @@ begin
|
||||||
+ LineEnding + 'Do you wish to pause execution ?', [signame, sigmean, line, fullname]),
|
+ LineEnding + 'Do you wish to pause execution ?', [signame, sigmean, line, fullname]),
|
||||||
'Unexpected signal received') = mrNo then
|
'Unexpected signal received') = mrNo then
|
||||||
gdbCommand('continue', @gdboutJsonize)
|
gdbCommand('continue', @gdboutJsonize)
|
||||||
else
|
else if (line <> -1) and fullname.fileExists then
|
||||||
begin
|
subjDebugBreak(fSubj, fullname, line, dbSignal);
|
||||||
if (line <> -1) and fullname.fileExists then
|
|
||||||
begin
|
|
||||||
getMultiDocHandler.openDocument(fullname);
|
|
||||||
fDoc.setFocus;
|
|
||||||
fDoc.CaretY:= line;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
@ -992,7 +978,7 @@ end;
|
||||||
|
|
||||||
procedure TCEGdbWidget.btnStopClick(Sender: TObject);
|
procedure TCEGdbWidget.btnStopClick(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
gdbCommand('kill', @gdboutQuiet);
|
gdbCommand('kill', @gdboutJsonize);
|
||||||
killGdb;
|
killGdb;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
|
@ -22,7 +22,7 @@ type
|
||||||
* Each project format has its own dedicated editors.
|
* Each project format has its own dedicated editors.
|
||||||
* A few common properties allow some generic operations whatever is the format.
|
* A few common properties allow some generic operations whatever is the format.
|
||||||
*)
|
*)
|
||||||
ICECommonProject = interface(ISubjectType)
|
ICECommonProject = interface
|
||||||
['ICECommonProject']
|
['ICECommonProject']
|
||||||
|
|
||||||
// general properties ------------------------------------------------------
|
// general properties ------------------------------------------------------
|
||||||
|
@ -98,7 +98,7 @@ type
|
||||||
(**
|
(**
|
||||||
* An implementer declares some actions on demand.
|
* An implementer declares some actions on demand.
|
||||||
*)
|
*)
|
||||||
ICEContextualActions = interface(ISubjectType)
|
ICEContextualActions = interface(IObserverType)
|
||||||
['ICEContextualActions']
|
['ICEContextualActions']
|
||||||
// declares a context name for the actions
|
// declares a context name for the actions
|
||||||
function contextName: string;
|
function contextName: string;
|
||||||
|
@ -113,7 +113,7 @@ type
|
||||||
(**
|
(**
|
||||||
* An implementer is informed about the current file(s).
|
* An implementer is informed about the current file(s).
|
||||||
*)
|
*)
|
||||||
ICEDocumentObserver = interface(ISubjectType)
|
ICEDocumentObserver = interface(IObserverType)
|
||||||
['ICEDocumentObserver']
|
['ICEDocumentObserver']
|
||||||
// document has been created (empty, runnable, project source, ...).
|
// document has been created (empty, runnable, project source, ...).
|
||||||
procedure docNew(document: TCESynMemo);
|
procedure docNew(document: TCESynMemo);
|
||||||
|
@ -139,7 +139,7 @@ type
|
||||||
* - the current project, the one that's active) which can be either the FSP
|
* - the current project, the one that's active) which can be either the FSP
|
||||||
* or one of the project in the group.
|
* or one of the project in the group.
|
||||||
*)
|
*)
|
||||||
ICEProjectObserver = interface(ISubjectType)
|
ICEProjectObserver = interface(IObserverType)
|
||||||
['ICEProjectObserver']
|
['ICEProjectObserver']
|
||||||
// a project has been created/opened
|
// a project has been created/opened
|
||||||
procedure projNew(project: ICECommonProject);
|
procedure projNew(project: ICECommonProject);
|
||||||
|
@ -164,7 +164,7 @@ type
|
||||||
(**
|
(**
|
||||||
* An implementer can add a main menu entry.
|
* An implementer can add a main menu entry.
|
||||||
*)
|
*)
|
||||||
ICEMainMenuProvider = interface(ISubjectType)
|
ICEMainMenuProvider = interface(IObserverType)
|
||||||
['ICEMainMenuProvider']
|
['ICEMainMenuProvider']
|
||||||
// item is a new mainMenu entry. item must be filled with the sub-items to be added.
|
// item is a new mainMenu entry. item must be filled with the sub-items to be added.
|
||||||
procedure menuDeclare(item: TMenuItem);
|
procedure menuDeclare(item: TMenuItem);
|
||||||
|
@ -182,7 +182,7 @@ type
|
||||||
* An implementer declares some actions which have their own main menu entry and
|
* An implementer declares some actions which have their own main menu entry and
|
||||||
* whose shortcuts are automatically handled
|
* whose shortcuts are automatically handled
|
||||||
*)
|
*)
|
||||||
ICEActionProvider = interface(ISubjectType)
|
ICEActionProvider = interface(IObserverType)
|
||||||
['ICEActionProvider']
|
['ICEActionProvider']
|
||||||
// the action handler will clear the references to the actions collected previously and start collecting if result.
|
// the action handler will clear the references to the actions collected previously and start collecting if result.
|
||||||
function actHandlerWantRecollect: boolean;
|
function actHandlerWantRecollect: boolean;
|
||||||
|
@ -203,7 +203,7 @@ type
|
||||||
(**
|
(**
|
||||||
* An implementer can expose customizable shortcuts to be edited in a dedicated widget.
|
* An implementer can expose customizable shortcuts to be edited in a dedicated widget.
|
||||||
*)
|
*)
|
||||||
ICEEditableShortCut = interface(ISubjectType)
|
ICEEditableShortCut = interface(IObserverType)
|
||||||
['ICEEditableShortCut']
|
['ICEEditableShortCut']
|
||||||
// a TCEEditableShortCutSubject will start to collect shortcuts if result.
|
// a TCEEditableShortCutSubject will start to collect shortcuts if result.
|
||||||
function scedWantFirst: boolean;
|
function scedWantFirst: boolean;
|
||||||
|
@ -237,7 +237,7 @@ type
|
||||||
(**
|
(**
|
||||||
* An implementer can expose options to be edited in a dedicated widget.
|
* An implementer can expose options to be edited in a dedicated widget.
|
||||||
*)
|
*)
|
||||||
ICEEditableOptions = interface(ISubjectType)
|
ICEEditableOptions = interface(IObserverType)
|
||||||
['ICEEditableOptions']
|
['ICEEditableOptions']
|
||||||
// the widget wants the category.
|
// the widget wants the category.
|
||||||
function optionedWantCategory(): string;
|
function optionedWantCategory(): string;
|
||||||
|
|
|
@ -57,8 +57,6 @@ type
|
||||||
property isUpdating: boolean read getIsUpdating;
|
property isUpdating: boolean read getIsUpdating;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(**
|
(**
|
||||||
* Interface for a Coedit subject. Basically designed to hold a list of observer
|
* Interface for a Coedit subject. Basically designed to hold a list of observer
|
||||||
*)
|
*)
|
||||||
|
@ -70,15 +68,18 @@ type
|
||||||
// optionally implemented to trigger all the methods of the observer interface.
|
// optionally implemented to trigger all the methods of the observer interface.
|
||||||
end;
|
end;
|
||||||
|
|
||||||
// Base type for an interface that contains the methods of a subject.
|
(**
|
||||||
ISubjectType = interface
|
* Base type used as constraint for an interface that contains
|
||||||
|
* the methods called by a ICESubject.
|
||||||
|
*)
|
||||||
|
IObserverType = interface
|
||||||
end;
|
end;
|
||||||
|
|
||||||
(**
|
(**
|
||||||
* Standard implementation of an ICESubject.
|
* Standard implementation of an ICESubject.
|
||||||
* Any descendant adds itself to the global EntitiesConnector.
|
* Any descendant automatically adds itself to the EntitiesConnector.
|
||||||
*)
|
*)
|
||||||
generic TCECustomSubject<T:ISubjectType> = class(ICESubject)
|
generic TCECustomSubject<T:IObserverType> = class(ICESubject)
|
||||||
protected
|
protected
|
||||||
fObservers: TObjectList;
|
fObservers: TObjectList;
|
||||||
// test for a specific interface when adding an observer.
|
// test for a specific interface when adding an observer.
|
||||||
|
|
|
@ -11,7 +11,7 @@ uses
|
||||||
SynEditMarks, SynEditTypes, SynHighlighterJScript, SynBeautifier, dialogs,
|
SynEditMarks, SynEditTypes, SynHighlighterJScript, SynBeautifier, dialogs,
|
||||||
fpjson, jsonparser, LazUTF8, LazUTF8Classes, Buttons, StdCtrls,
|
fpjson, jsonparser, LazUTF8, LazUTF8Classes, Buttons, StdCtrls,
|
||||||
ce_common, ce_writableComponent, ce_d2syn, ce_txtsyn, ce_dialogs,
|
ce_common, ce_writableComponent, ce_d2syn, ce_txtsyn, ce_dialogs,
|
||||||
ce_sharedres, ce_dlang, ce_stringrange;
|
ce_sharedres, ce_dlang, ce_stringrange, ce_dbgitf, ce_observer;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
|
@ -49,12 +49,6 @@ type
|
||||||
|
|
||||||
TIdentifierMatchOptions = set of TIdentifierMatchOption;
|
TIdentifierMatchOptions = set of TIdentifierMatchOption;
|
||||||
|
|
||||||
TBreakPointModification = (bpAdded, bpRemoved);
|
|
||||||
|
|
||||||
// breakpoint added or removed
|
|
||||||
TBreakPointModifyEvent = procedure(sender: TCESynMemo; line: integer;
|
|
||||||
modification: TBreakPointModification) of object;
|
|
||||||
|
|
||||||
// Simple THintWindow descendant allowing the font size to be in sync with the editor.
|
// Simple THintWindow descendant allowing the font size to be in sync with the editor.
|
||||||
TCEEditorHintWindow = class(THintWindow)
|
TCEEditorHintWindow = class(THintWindow)
|
||||||
public
|
public
|
||||||
|
@ -122,7 +116,7 @@ type
|
||||||
|
|
||||||
TSortDialog = class;
|
TSortDialog = class;
|
||||||
|
|
||||||
TCESynMemo = class(TSynEdit)
|
TCESynMemo = class(TSynEdit, ICEDebugObserver)
|
||||||
private
|
private
|
||||||
fFilename: string;
|
fFilename: string;
|
||||||
fDastWorxExename: string;
|
fDastWorxExename: string;
|
||||||
|
@ -153,7 +147,6 @@ type
|
||||||
fTxtHighlighter: TSynTxtSyn;
|
fTxtHighlighter: TSynTxtSyn;
|
||||||
fImages: TImageList;
|
fImages: TImageList;
|
||||||
fBreakPoints: TFPList;
|
fBreakPoints: TFPList;
|
||||||
fBreakpointEvent: TBreakPointModifyEvent;
|
|
||||||
fMatchSelectionOpts: TSynSearchOptions;
|
fMatchSelectionOpts: TSynSearchOptions;
|
||||||
fMatchIdentOpts: TSynSearchOptions;
|
fMatchIdentOpts: TSynSearchOptions;
|
||||||
fMatchOpts: TIdentifierMatchOptions;
|
fMatchOpts: TIdentifierMatchOptions;
|
||||||
|
@ -171,6 +164,7 @@ type
|
||||||
fModuleTokFound: boolean;
|
fModuleTokFound: boolean;
|
||||||
fHasModuleDeclaration: boolean;
|
fHasModuleDeclaration: boolean;
|
||||||
fLastCompletion: string;
|
fLastCompletion: string;
|
||||||
|
fDebugger: ICEDebugger;
|
||||||
procedure decCallTipsLvl;
|
procedure decCallTipsLvl;
|
||||||
procedure setMatchOpts(value: TIdentifierMatchOptions);
|
procedure setMatchOpts(value: TIdentifierMatchOptions);
|
||||||
function getMouseBytePosition: Integer;
|
function getMouseBytePosition: Integer;
|
||||||
|
@ -195,6 +189,7 @@ type
|
||||||
procedure gutterClick(Sender: TObject; X, Y, Line: integer; mark: TSynEditMark);
|
procedure gutterClick(Sender: TObject; X, Y, Line: integer; mark: TSynEditMark);
|
||||||
procedure addBreakPoint(line: integer);
|
procedure addBreakPoint(line: integer);
|
||||||
procedure removeBreakPoint(line: integer);
|
procedure removeBreakPoint(line: integer);
|
||||||
|
procedure removeDebugTimeMarks;
|
||||||
function findBreakPoint(line: integer): boolean;
|
function findBreakPoint(line: integer): boolean;
|
||||||
procedure showCallTips(const tips: string);
|
procedure showCallTips(const tips: string);
|
||||||
function lexCanCloseBrace: boolean;
|
function lexCanCloseBrace: boolean;
|
||||||
|
@ -204,6 +199,14 @@ type
|
||||||
procedure setSelectionOrWordCase(upper: boolean);
|
procedure setSelectionOrWordCase(upper: boolean);
|
||||||
procedure sortSelectedLines(descending, caseSensitive: boolean);
|
procedure sortSelectedLines(descending, caseSensitive: boolean);
|
||||||
procedure tokFoundForCaption(const token: PLexToken; out stop: boolean);
|
procedure tokFoundForCaption(const token: PLexToken; out stop: boolean);
|
||||||
|
//
|
||||||
|
procedure debugStart(debugger: ICEDebugger);
|
||||||
|
procedure debugStop;
|
||||||
|
function debugQueryBpCount: integer;
|
||||||
|
procedure debugQueryBreakPoint(const index: integer; out fname: string; out line: integer; out kind: TBreakPointKind);
|
||||||
|
procedure debugBreak(const fname: string; line: integer; reason: TCEDebugBreakReason);
|
||||||
|
function breakPointsCount: integer;
|
||||||
|
function breakPointLine(index: integer): integer;
|
||||||
protected
|
protected
|
||||||
procedure DoEnter; override;
|
procedure DoEnter; override;
|
||||||
procedure DoExit; override;
|
procedure DoExit; override;
|
||||||
|
@ -223,6 +226,7 @@ type
|
||||||
constructor Create(aOwner: TComponent); override;
|
constructor Create(aOwner: TComponent); override;
|
||||||
destructor destroy; override;
|
destructor destroy; override;
|
||||||
procedure setFocus; override;
|
procedure setFocus; override;
|
||||||
|
procedure showPage;
|
||||||
//
|
//
|
||||||
function pageCaption(checkModule: boolean): string;
|
function pageCaption(checkModule: boolean): string;
|
||||||
procedure checkFileDate;
|
procedure checkFileDate;
|
||||||
|
@ -243,12 +247,8 @@ type
|
||||||
procedure ShowPhobosDoc;
|
procedure ShowPhobosDoc;
|
||||||
procedure nextChangedArea;
|
procedure nextChangedArea;
|
||||||
procedure previousChangedArea;
|
procedure previousChangedArea;
|
||||||
function implementMain: THasMain;
|
|
||||||
procedure sortLines;
|
procedure sortLines;
|
||||||
//
|
function implementMain: THasMain;
|
||||||
function breakPointsCount: integer;
|
|
||||||
function breakPointLine(index: integer): integer;
|
|
||||||
property onBreakpointModify: TBreakPointModifyEvent read fBreakpointEvent write fBreakpointEvent;
|
|
||||||
//
|
//
|
||||||
property IdentifierMatchOptions: TIdentifierMatchOptions read fMatchOpts write setMatchOpts;
|
property IdentifierMatchOptions: TIdentifierMatchOptions read fMatchOpts write setMatchOpts;
|
||||||
property Identifier: string read fIdentifier;
|
property Identifier: string read fIdentifier;
|
||||||
|
@ -723,6 +723,9 @@ begin
|
||||||
fImages := TImageList.Create(self);
|
fImages := TImageList.Create(self);
|
||||||
fImages.AddResourceName(HINSTANCE, 'BULLET_RED');
|
fImages.AddResourceName(HINSTANCE, 'BULLET_RED');
|
||||||
fImages.AddResourceName(HINSTANCE, 'BULLET_GREEN');
|
fImages.AddResourceName(HINSTANCE, 'BULLET_GREEN');
|
||||||
|
fImages.AddResourceName(HINSTANCE, 'BULLET_BLACK');
|
||||||
|
fImages.AddResourceName(HINSTANCE, 'BREAKS');
|
||||||
|
fImages.AddResourceName(HINSTANCE, 'STEP');
|
||||||
fBreakPoints := TFPList.Create;
|
fBreakPoints := TFPList.Create;
|
||||||
//
|
//
|
||||||
fPositions := TCESynMemoPositions.create(self);
|
fPositions := TCESynMemoPositions.create(self);
|
||||||
|
@ -742,12 +745,14 @@ begin
|
||||||
fDastWorxExename:= exeFullName('dastworx' + exeExt);
|
fDastWorxExename:= exeFullName('dastworx' + exeExt);
|
||||||
//
|
//
|
||||||
subjDocNew(TCEMultiDocSubject(fMultiDocSubject), self);
|
subjDocNew(TCEMultiDocSubject(fMultiDocSubject), self);
|
||||||
|
EntitiesConnector.addObserver(self);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TCESynMemo.destroy;
|
destructor TCESynMemo.destroy;
|
||||||
begin
|
begin
|
||||||
saveCache;
|
saveCache;
|
||||||
//
|
//
|
||||||
|
EntitiesConnector.removeObserver(self);
|
||||||
subjDocClosing(TCEMultiDocSubject(fMultiDocSubject), self);
|
subjDocClosing(TCEMultiDocSubject(fMultiDocSubject), self);
|
||||||
fMultiDocSubject.Free;
|
fMultiDocSubject.Free;
|
||||||
fPositions.Free;
|
fPositions.Free;
|
||||||
|
@ -783,6 +788,11 @@ begin
|
||||||
subjDocFocused(TCEMultiDocSubject(fMultiDocSubject), self);
|
subjDocFocused(TCEMultiDocSubject(fMultiDocSubject), self);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TCESynMemo.showPage;
|
||||||
|
begin
|
||||||
|
getMultiDocHandler.openDocument(fileName);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TCESynMemo.DoEnter;
|
procedure TCESynMemo.DoEnter;
|
||||||
begin
|
begin
|
||||||
inherited;
|
inherited;
|
||||||
|
@ -2404,7 +2414,7 @@ begin
|
||||||
end;
|
end;
|
||||||
{$ENDREGION --------------------------------------------------------------------}
|
{$ENDREGION --------------------------------------------------------------------}
|
||||||
|
|
||||||
{$REGION breakpoints -----------------------------------------------------------}
|
{$REGION debugging/breakpoints -----------------------------------------------------------}
|
||||||
function TCESynMemo.breakPointsCount: integer;
|
function TCESynMemo.breakPointsCount: integer;
|
||||||
begin
|
begin
|
||||||
exit(fBreakPoints.Count);
|
exit(fBreakPoints.Count);
|
||||||
|
@ -2434,8 +2444,8 @@ begin
|
||||||
{$PUSH}{$WARNINGS OFF}{$HINTS OFF}
|
{$PUSH}{$WARNINGS OFF}{$HINTS OFF}
|
||||||
fBreakPoints.Add(pointer(line));
|
fBreakPoints.Add(pointer(line));
|
||||||
{$POP}
|
{$POP}
|
||||||
if assigned(fBreakpointEvent) then
|
if assigned(fDebugger) then
|
||||||
fBreakpointEvent(self, line, bpAdded);
|
fDebugger.addBreakPoint(fFilename, line, bpkBreak);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCESynMemo.removeBreakPoint(line: integer);
|
procedure TCESynMemo.removeBreakPoint(line: integer);
|
||||||
|
@ -2447,8 +2457,13 @@ begin
|
||||||
{$PUSH}{$WARNINGS OFF}{$HINTS OFF}
|
{$PUSH}{$WARNINGS OFF}{$HINTS OFF}
|
||||||
fBreakPoints.Remove(pointer(line));
|
fBreakPoints.Remove(pointer(line));
|
||||||
{$POP}
|
{$POP}
|
||||||
if assigned(fBreakpointEvent) then
|
if assigned(fDebugger) then
|
||||||
fBreakpointEvent(self, line, bpRemoved);
|
fDebugger.removeBreakPoint(fFilename, line);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCESynMemo.removeDebugTimeMarks;
|
||||||
|
begin
|
||||||
|
//TODO-cGDB: clean gutter marks generated during the session
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TCESynMemo.findBreakPoint(line: integer): boolean;
|
function TCESynMemo.findBreakPoint(line: integer): boolean;
|
||||||
|
@ -2465,6 +2480,44 @@ begin
|
||||||
else
|
else
|
||||||
addBreakPoint(line);
|
addBreakPoint(line);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TCESynMemo.debugStart(debugger: ICEDebugger);
|
||||||
|
begin
|
||||||
|
fDebugger := debugger;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCESynMemo.debugStop;
|
||||||
|
begin
|
||||||
|
fDebugger := nil;
|
||||||
|
removeDebugTimeMarks;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TCESynMemo.debugQueryBpCount: integer;
|
||||||
|
begin
|
||||||
|
exit(fBreakPoints.Count);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCESynMemo.debugQueryBreakPoint(const index: integer; out fname: string;
|
||||||
|
out line: integer; out kind: TBreakPointKind);
|
||||||
|
begin
|
||||||
|
fname:= fFilename;
|
||||||
|
line := breakPointLine(index);
|
||||||
|
kind := bpkBreak;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCESynMemo.debugBreak(const fname: string; line: integer;
|
||||||
|
reason: TCEDebugBreakReason);
|
||||||
|
begin
|
||||||
|
if fname <> fFilename then
|
||||||
|
exit;
|
||||||
|
showPage;
|
||||||
|
caretY := line;
|
||||||
|
// TODO-cDBG: add markup according to break reason
|
||||||
|
case reason of
|
||||||
|
dbBreakPoint:;
|
||||||
|
dbSignal:;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
{$ENDREGION --------------------------------------------------------------------}
|
{$ENDREGION --------------------------------------------------------------------}
|
||||||
|
|
||||||
{$ENDREGION --------------------------------------------------------------------}
|
{$ENDREGION --------------------------------------------------------------------}
|
||||||
|
|
Loading…
Reference in New Issue