1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041 |
- {
- $Id$
- This file is part of the Free Pascal Integrated Development Environment
- Copyright (c) 1998 by Berczi Gabor
- Debugger call routines for the IDE
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program 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.
- **********************************************************************}
- unit FPDebug;
- interface
- uses
- Objects,Dialogs,Drivers,Views,
- GDBCon,GDBInt,Menus,
- WViews,
- FPViews;
- type
- PDebugController=^TDebugController;
- TDebugController=object(TGDBController)
- InvalidSourceLine : boolean;
- LastFileName : string;
- LastSource : PView; {PsourceWindow !! }
- HiddenStepsCount : longint;
- constructor Init(const exefn:string);
- destructor Done;
- procedure DoSelectSourceline(const fn:string;line:longint);virtual;
- { procedure DoStartSession;virtual;
- procedure DoBreakSession;virtual;}
- procedure DoEndSession(code:longint);virtual;
- procedure AnnotateError;
- procedure InsertBreakpoints;
- procedure RemoveBreakpoints;
- procedure ReadWatches;
- procedure ResetBreakpointsValues;
- procedure DoDebuggerScreen;virtual;
- procedure DoUserScreen;virtual;
- procedure Reset;virtual;
- procedure Run;virtual;
- procedure Continue;virtual;
- procedure CommandBegin(const s:string);virtual;
- procedure CommandEnd(const s:string);virtual;
- end;
- BreakpointType = (bt_function,bt_file_line,bt_watch,bt_awatch,bt_rwatch,bt_invalid);
- BreakpointState = (bs_enabled,bs_disabled,bs_deleted);
- PBreakpointCollection=^TBreakpointCollection;
- PBreakpoint=^TBreakpoint;
- TBreakpoint=object(TObject)
- typ : BreakpointType;
- state : BreakpointState;
- owner : PBreakpointCollection;
- Name : PString; { either function name or expr to watch }
- FileName : PString;
- OldValue,CurrentValue : Pstring;
- Line : Longint; { only used for bt_file_line type }
- Conditions : PString; { conditions relative to that breakpoint }
- IgnoreCount : Longint; { how many counts should be ignored }
- Commands : pchar; { commands that should be executed on breakpoint }
- GDBIndex : longint;
- GDBState : BreakpointState;
- constructor Init_function(Const AFunc : String);
- constructor Init_Empty;
- constructor Init_file_line(AFile : String; ALine : longint);
- constructor Init_type(atyp : BreakpointType;Const AnExpr : String);
- procedure Insert;
- procedure Remove;
- procedure Enable;
- procedure Disable;
- procedure ResetValues;
- destructor Done;virtual;
- end;
- TBreakpointCollection=object(TCollection)
- function At(Index: Integer): PBreakpoint;
- function GetGDB(index : longint) : PBreakpoint;
- function GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
- function ToggleFileLine(Const FileName: String;LineNr : Longint) : boolean;
- procedure Update;
- procedure ShowBreakpoints(W : PSourceWindow);
- end;
- PBreakpointItem = ^TBreakpointItem;
- TBreakpointItem = object(TObject)
- Breakpoint : PBreakpoint;
- constructor Init(ABreakpoint : PBreakpoint);
- function GetText(MaxLen: Sw_integer): string; virtual;
- procedure Selected; virtual;
- function GetModuleName: string; virtual;
- end;
- PBreakpointListBox = ^TBreakpointListBox;
- TBreakpointListBox = object(THSListBox)
- Transparent : boolean;
- NoSelection : boolean;
- MaxWidth : Sw_integer;
- (* ModuleNames : PStoreCollection; *)
- constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
- procedure AddBreakpoint(P: PBreakpointItem); virtual;
- function GetText(Item,MaxLen: Sw_Integer): String; virtual;
- function GetLocalMenu: PMenu;virtual;
- procedure Clear; virtual;
- procedure TrackSource; virtual;
- procedure EditNew; virtual;
- procedure EditCurrent; virtual;
- procedure DeleteCurrent; virtual;
- procedure ToggleCurrent;
- procedure Draw; virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- (* constructor Load(var S: TStream);
- procedure Store(var S: TStream); *)
- destructor Done; virtual;
- end;
- PBreakpointsWindow = ^TBreakpointsWindow;
- TBreakpointsWindow = object(TDlgWindow)
- BreakLB : PBreakpointListBox;
- constructor Init;
- procedure AddBreakpoint(ABreakpoint : PBreakpoint);
- procedure ClearBreakpoints;
- procedure ReloadBreakpoints;
- procedure Close; virtual;
- procedure SizeLimits(var Min, Max: TPoint);virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- procedure Update; virtual;
- destructor Done; virtual;
- end;
- PBreakpointItemDialog = ^TBreakpointItemDialog;
- TBreakpointItemDialog = object(TCenterDialog)
- constructor Init(ABreakpoint: PBreakpoint);
- function Execute: Word; virtual;
- private
- Breakpoint : PBreakpoint;
- TypeRB : PRadioButtons;
- NameIL : PInputLine;
- ConditionsIL: PInputLine;
- LineIL : PInputLine;
- IgnoreIL : PInputLine;
- end;
- PWatch = ^TWatch;
- TWatch = Object(TObject)
- constructor Init(s : string);
- procedure rename(s : string);
- procedure Get_new_value;
- destructor done;virtual;
- private
- expr : pstring;
- last_value,current_value : pchar;
- end;
- PWatchesCollection = ^TWatchesCollection;
- TWatchesCollection = Object(TCollection)
- constructor Init;
- procedure Insert(Item: Pointer); virtual;
- function At(Index: Integer): PWatch;
- procedure Update;
- private
- MaxW : integer;
- end;
- PWatchesListBox = ^TWatchesListBox;
- TWatchesListBox = object(THSListBox)
- Transparent : boolean;
- MaxWidth : Sw_integer;
- constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
- (* procedure AddWatch(P: PWatch); virtual; *)
- procedure Update(AMaxWidth : integer);
- function GetIndentedText(Item,Indent,MaxLen: Sw_Integer): String; virtual;
- function GetLocalMenu: PMenu;virtual;
- (* procedure Clear; virtual;
- procedure TrackSource; virtual;*)
- procedure EditNew; virtual;
- procedure EditCurrent; virtual;
- procedure DeleteCurrent; virtual;
- (*procedure ToggleCurrent; *)
- procedure Draw; virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- (* constructor Load(var S: TStream);
- procedure Store(var S: TStream); *)
- destructor Done; virtual;
- end;
- PWatchItemDialog = ^TWatchItemDialog;
- TWatchItemDialog = object(TCenterDialog)
- constructor Init(AWatch: PWatch);
- function Execute: Word; virtual;
- private
- Watch : PWatch;
- NameIL : PInputLine;
- TextST : PAdvancedStaticText;
- end;
- PWatchesWindow = ^TWatchesWindow;
- TWatchesWindow = Object(TDlgWindow)
- WLB : PWatchesListBox;
- Constructor Init;
- procedure Update; virtual;
- destructor Done; virtual;
- end;
- const
- BreakpointTypeStr : Array[BreakpointType] of String[9]
- = ( 'function','file-line','watch','awatch','rwatch','invalid' );
- BreakpointStateStr : Array[BreakpointState] of String[8]
- = ( 'enabled','disabled','invalid' );
- var
- Debugger : PDebugController;
- BreakpointCollection : PBreakpointCollection;
- WatchesCollection : PwatchesCollection;
- procedure InitDebugger;
- procedure DoneDebugger;
- procedure InitGDBWindow;
- procedure DoneGDBWindow;
- procedure InitBreakpoints;
- procedure DoneBreakpoints;
- procedure InitWatches;
- procedure DoneWatches;
- implementation
- uses
- Dos,Mouse,Video,
- App,Commands,Strings,
- FPVars,FPUtils,FPConst,
- FPIntf,FPCompile,FPIde,
- Validate,WEditor,WUtils;
- {****************************************************************************
- TDebugController
- ****************************************************************************}
- constructor TDebugController.Init(const exefn:string);
- var f: string;
- begin
- inherited Init;
- f := exefn;
- LoadFile(f);
- SetArgs(GetRunParameters);
- Debugger:=@self;
- InsertBreakpoints;
- ReadWatches;
- end;
- procedure TDebugController.InsertBreakpoints;
- procedure DoInsert(PB : PBreakpoint);
- begin
- PB^.Insert;
- end;
- begin
- BreakpointCollection^.ForEach(@DoInsert);
- end;
- procedure TDebugController.ReadWatches;
- procedure DoRead(PB : PWatch);
- begin
- PB^.Get_new_value;
- end;
- begin
- WatchesCollection^.ForEach(@DoRead);
- end;
- procedure TDebugController.RemoveBreakpoints;
- procedure DoDelete(PB : PBreakpoint);
- begin
- PB^.Remove;
- end;
- begin
- BreakpointCollection^.ForEach(@DoDelete);
- end;
- procedure TDebugController.ResetBreakpointsValues;
- procedure DoResetVal(PB : PBreakpoint);
- begin
- PB^.ResetValues;
- end;
- begin
- BreakpointCollection^.ForEach(@DoResetVal);
- end;
- destructor TDebugController.Done;
- begin
- { kill the program if running }
- Reset;
- RemoveBreakpoints;
- inherited Done;
- end;
- procedure TDebugController.Run;
- begin
- ResetBreakpointsValues;
- inherited Run;
- MyApp.SetCmdState([cmResetDebugger],true);
- end;
- procedure TDebugController.Continue;
- begin
- if not debugger_started then
- Run
- else
- inherited Continue;
- end;
- procedure TDebugController.CommandBegin(const s:string);
- begin
- if assigned(GDBWindow) and (in_command>1) then
- begin
- { We should do something special for errors !! }
- If StrLen(GetError)>0 then
- GDBWindow^.WriteErrorText(GetError);
- GDBWindow^.WriteOutputText(GetOutput);
- end;
- if assigned(GDBWindow) then
- GDBWindow^.WriteString(S);
- end;
- procedure TDebugController.CommandEnd(const s:string);
- begin
- if assigned(GDBWindow) and (in_command=0) then
- begin
- { We should do something special for errors !! }
- If StrLen(GetError)>0 then
- GDBWindow^.WriteErrorText(GetError);
- GDBWindow^.WriteOutputText(GetOutput);
- GDBWindow^.Editor^.TextEnd;
- end;
- end;
- procedure TDebugController.Reset;
- var
- W : PSourceWindow;
- begin
- inherited Reset;
- MyApp.SetCmdState([cmResetDebugger],false);
- W:=PSourceWindow(LastSource);
- if assigned(W) then
- W^.Editor^.SetHighlightRow(-1);
- end;
- procedure TDebugController.AnnotateError;
- var errornb : longint;
- begin
- if error then
- begin
- errornb:=error_num;
- ErrorBox(#3'Error within GDB'#13#3'Error code = %d',@errornb);
- end;
- end;
- procedure TDebugController.DoSelectSourceLine(const fn:string;line:longint);
- var
- W: PSourceWindow;
- Found : boolean;
- PB : PBreakpoint;
- S : String;
- BreakIndex : longint;
- begin
- BreakIndex:=stop_breakpoint_number;
- Desktop^.Lock;
- { 0 based line count in Editor }
- if Line>0 then
- dec(Line);
- if (fn=LastFileName) then
- begin
- W:=PSourceWindow(LastSource);
- if assigned(W) then
- begin
- W^.Editor^.SetCurPtr(0,Line);
- W^.Editor^.TrackCursor(true);
- W^.Editor^.SetHighlightRow(Line);
- ReadWatches;
- if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
- W^.Select;
- InvalidSourceLine:=false;
- end
- else
- InvalidSourceLine:=true;
- end
- else
- begin
- W:=TryToOpenFile(nil,fn,0,Line,false);
- if assigned(W) then
- begin
- W^.Editor^.SetHighlightRow(Line);
- W^.Editor^.TrackCursor(true);
- ReadWatches;
- if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
- W^.Select;
- LastSource:=W;
- InvalidSourceLine:=false;
- end
- { only search a file once }
- else
- begin
- Desktop^.UnLock;
- Found:=MyApp.OpenSearch(fn);
- Desktop^.Lock;
- if not Found then
- begin
- InvalidSourceLine:=true;
- LastSource:=Nil;
- end
- else
- begin
- { should now be open }
- W:=TryToOpenFile(nil,fn,0,Line,true);
- W^.Editor^.SetHighlightRow(Line);
- W^.Editor^.TrackCursor(true);
- ReadWatches;
- if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
- W^.Select;
- LastSource:=W;
- InvalidSourceLine:=false;
- end;
- end;
- end;
- LastFileName:=fn;
- Desktop^.UnLock;
- if BreakIndex>0 then
- begin
- PB:=BreakpointCollection^.GetGDB(BreakIndex);
- { For watch we should get old and new value !! }
- if (Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive)) and
- (PB^.typ<>bt_file_line) and (PB^.typ<>bt_function) then
- begin
- Command('p '+GetStr(PB^.Name));
- S:=StrPas(GetOutput);
- If Pos('=',S)>0 then
- S:=Copy(S,Pos('=',S)+1,255);
- If S[Length(S)]=#10 then
- Delete(S,Length(S),1);
- if Assigned(PB^.OldValue) then
- DisposeStr(PB^.OldValue);
- PB^.OldValue:=PB^.CurrentValue;
- PB^.CurrentValue:=NewStr(S);
- If PB^.typ=bt_function then
- WarningBox(#3'GDB stopped due to'#13+
- #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name),nil)
- else if (GetStr(PB^.OldValue)<>S) then
- WarningBox(#3'GDB stopped due to'#13+
- #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
- #3+'Old value = '+GetStr(PB^.OldValue)+#13+
- #3+'New value = '+GetStr(PB^.CurrentValue),nil)
- else
- WarningBox(#3'GDB stopped due to'#13+
- #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
- #3+' value = '+GetStr(PB^.CurrentValue),nil);
- end;
- end;
- end;
- procedure TDebugController.DoEndSession(code:longint);
- var P :Array[1..2] of longint;
- W : PSourceWindow;
- begin
- MyApp.SetCmdState([cmResetDebugger],false);
- W:=PSourceWindow(LastSource);
- if assigned(W) then
- W^.Editor^.SetHighlightRow(-1);
- If HiddenStepsCount=0 then
- InformationBox(#3'Program exited with '#13#3'exitcode = %d',@code)
- else
- begin
- P[1]:=code;
- P[2]:=HiddenStepsCount;
- WarningBox(#3'Program exited with '#13+
- #3'exitcode = %d'#13+
- #3'hidden steps = %d',@P);
- end;
- end;
- procedure TDebugController.DoDebuggerScreen;
- begin
- MyApp.ShowIDEScreen;
- end;
- procedure TDebugController.DoUserScreen;
- begin
- MyApp.ShowUserScreen;
- end;
- {****************************************************************************
- TBreakpoint
- ****************************************************************************}
- constructor TBreakpoint.Init_function(Const AFunc : String);
- begin
- typ:=bt_function;
- state:=bs_enabled;
- GDBState:=bs_deleted;
- Name:=NewStr(AFunc);
- FileName:=nil;
- Line:=0;
- IgnoreCount:=0;
- Commands:=nil;
- Conditions:=nil;
- OldValue:=nil;
- CurrentValue:=nil;
- end;
- constructor TBreakpoint.Init_Empty;
- begin
- typ:=bt_function;
- state:=bs_enabled;
- GDBState:=bs_deleted;
- Name:=Nil;
- FileName:=nil;
- Line:=0;
- IgnoreCount:=0;
- Commands:=nil;
- Conditions:=nil;
- OldValue:=nil;
- CurrentValue:=nil;
- end;
- constructor TBreakpoint.Init_type(atyp : BreakpointType;Const AnExpr : String);
- begin
- typ:=atyp;
- state:=bs_enabled;
- GDBState:=bs_deleted;
- Name:=NewStr(AnExpr);
- IgnoreCount:=0;
- Commands:=nil;
- Conditions:=nil;
- OldValue:=nil;
- CurrentValue:=nil;
- end;
- constructor TBreakpoint.Init_file_line(AFile : String; ALine : longint);
- begin
- typ:=bt_file_line;
- state:=bs_enabled;
- GDBState:=bs_deleted;
- { d:test.pas:12 does not work !! }
- { I do not know how to solve this if
- if (Length(AFile)>1) and (AFile[2]=':') then
- AFile:=Copy(AFile,3,255);
- Only use base name for now !! PM }
- FileName:=NewStr(AFile);
- Name:=nil;
- Line:=ALine;
- IgnoreCount:=0;
- Commands:=nil;
- Conditions:=nil;
- OldValue:=nil;
- CurrentValue:=nil;
- end;
- procedure TBreakpoint.Insert;
- begin
- If not assigned(Debugger) then Exit;
- Remove;
- Debugger^.last_breakpoint_number:=0;
- if (GDBState=bs_deleted) and (state=bs_enabled) then
- begin
- if (typ=bt_file_line) and assigned(FileName) then
- Debugger^.Command('break '+NameAndExtOf(FileName^)+':'+IntToStr(Line))
- else if (typ=bt_function) and assigned(name) then
- Debugger^.Command('break '+name^)
- else if (typ=bt_watch) and assigned(name) then
- Debugger^.Command('watch '+name^)
- else if (typ=bt_awatch) and assigned(name) then
- Debugger^.Command('awatch '+name^)
- else if (typ=bt_rwatch) and assigned(name) then
- Debugger^.Command('rwatch '+name^);
- if Debugger^.last_breakpoint_number<>0 then
- begin
- GDBIndex:=Debugger^.last_breakpoint_number;
- GDBState:=bs_enabled;
- Debugger^.Command('cond '+IntToStr(GDBIndex)+' '+GetStr(Conditions));
- Debugger^.Command('ignore '+IntToStr(GDBIndex)+' '+IntToStr(IgnoreCount));
- If Assigned(Commands) then
- begin
- {Commands are not handled yet }
- end;
- end
- else
- { Here there was a problem !! }
- begin
- GDBIndex:=0;
- ErrorBox(#3'Could not set Breakpoint'#13+
- #3+BreakpointTypeStr[typ]+' '+Name^,nil);
- state:=bs_disabled;
- end;
- end
- else if (GDBState=bs_disabled) and (state=bs_enabled) then
- Enable
- else if (GDBState=bs_enabled) and (state=bs_disabled) then
- Disable;
- end;
- procedure TBreakpoint.Remove;
- begin
- If not assigned(Debugger) then Exit;
- if GDBIndex>0 then
- Debugger^.Command('delete '+IntToStr(GDBIndex));
- GDBIndex:=0;
- GDBState:=bs_deleted;
- end;
- procedure TBreakpoint.Enable;
- begin
- If not assigned(Debugger) then Exit;
- if GDBIndex>0 then
- Debugger^.Command('enable '+IntToStr(GDBIndex))
- else
- Insert;
- GDBState:=bs_enabled;
- end;
- procedure TBreakpoint.Disable;
- begin
- If not assigned(Debugger) then Exit;
- if GDBIndex>0 then
- Debugger^.Command('disable '+IntToStr(GDBIndex));
- GDBState:=bs_disabled;
- end;
- procedure TBreakpoint.ResetValues;
- begin
- if assigned(OldValue) then
- DisposeStr(OldValue);
- OldValue:=nil;
- if assigned(CurrentValue) then
- DisposeStr(CurrentValue);
- CurrentValue:=nil;
- end;
- destructor TBreakpoint.Done;
- begin
- Remove;
- ResetValues;
- if assigned(Name) then
- DisposeStr(Name);
- if assigned(FileName) then
- DisposeStr(FileName);
- if assigned(Conditions) then
- DisposeStr(Conditions);
- if assigned(Commands) then
- StrDispose(Commands);
- inherited Done;
- end;
- {****************************************************************************
- TBreakpointCollection
- ****************************************************************************}
- function TBreakpointCollection.At(Index: Integer): PBreakpoint;
- begin
- At:=inherited At(Index);
- end;
- procedure TBreakpointCollection.Update;
- begin
- if assigned(Debugger) then
- begin
- Debugger^.RemoveBreakpoints;
- Debugger^.InsertBreakpoints;
- end;
- if assigned(BreakpointsWindow) then
- BreakpointsWindow^.Update;
- end;
- function TBreakpointCollection.GetGDB(index : longint) : PBreakpoint;
- function IsNum(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
- begin
- IsNum:=P^.GDBIndex=index;
- end;
- begin
- if index=0 then
- GetGDB:=nil
- else
- GetGDB:=FirstThat(@IsNum);
- end;
- procedure TBreakpointCollection.ShowBreakpoints(W : PSourceWindow);
- procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
- begin
- If assigned(P^.FileName) and (P^.FileName^=W^.Editor^.FileName) then
- W^.Editor^.SetLineBreakState(P^.Line,P^.state=bs_enabled);
- end;
- begin
- ForEach(@SetInSource);
- end;
- function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
- function IsThis(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
- begin
- IsThis:=(P^.typ=typ) and (P^.Name^=S);
- end;
- begin
- GetType:=FirstThat(@IsThis);
- end;
- function TBreakpointCollection.ToggleFileLine(Const FileName: String;LineNr : Longint) : boolean;
- var PB : PBreakpoint;
- function IsThere(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
- begin
- IsThere:=(P^.typ=bt_file_line) and (P^.FileName^=FileName) and (P^.Line=LineNr);
- end;
- begin
- PB:=FirstThat(@IsThere);
- ToggleFileLine:=false;
- If Assigned(PB) then
- if PB^.state=bs_disabled then
- begin
- PB^.state:=bs_enabled;
- ToggleFileLine:=true;
- end
- else if PB^.state=bs_enabled then
- PB^.state:=bs_disabled;
- If not assigned(PB) then
- begin
- PB:= New(PBreakpoint,Init_file_line(FileName,LineNr));
- if assigned(PB) then
- Begin
- Insert(PB);
- ToggleFileLine:=true;
- End;
- end;
- Update;
- end;
- {****************************************************************************
- TBreakpointItem
- ****************************************************************************}
- constructor TBreakpointItem.Init(ABreakpoint : PBreakpoint);
- begin
- inherited Init;
- Breakpoint:=ABreakpoint;
- end;
- function TBreakpointItem.GetText(MaxLen: Sw_integer): string;
- var S: string;
- begin
- with Breakpoint^ do
- begin
- S:=BreakpointTypeStr[typ];
- While Length(S)<10 do
- S:=S+' ';
- S:=S+'|';
- S:=S+BreakpointStateStr[state]+' ';
- While Length(S)<20 do
- S:=S+' ';
- S:=S+'|';
- if (typ=bt_file_line) then
- S:=S+NameAndExtOf(GetStr(FileName))+':'+IntToStr(Line)
- else
- S:=S+GetStr(name);
- While Length(S)<40 do
- S:=S+' ';
- S:=S+'|';
- if IgnoreCount>0 then
- S:=S+IntToStr(IgnoreCount);
- While Length(S)<49 do
- S:=S+' ';
- S:=S+'|';
- if assigned(Conditions) then
- S:=S+' '+GetStr(Conditions);
- if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
- GetText:=S;
- end;
- end;
- procedure TBreakpointItem.Selected;
- begin
- end;
- function TBreakpointItem.GetModuleName: string;
- begin
- if breakpoint^.typ=bt_file_line then
- GetModuleName:=GetStr(breakpoint^.FileName)
- else
- GetModuleName:='';
- end;
- {****************************************************************************
- TBreakpointListBox
- ****************************************************************************}
- constructor TBreakpointListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
- begin
- inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
- GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
- NoSelection:=true;
- end;
- function TBreakpointListBox.GetLocalMenu: PMenu;
- var M: PMenu;
- begin
- if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
- M:=NewMenu(
- NewItem('~G~oto source','',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
- NewItem('~E~dit breakpoint','',kbNoKey,cmEdit,hcNoContext,
- NewItem('~N~ew breakpoint','',kbNoKey,cmNew,hcNoContext,
- NewItem('~D~elete breakpoint','',kbNoKey,cmDelete,hcNoContext,
- NewItem('~T~oggle state','',kbNoKey,cmToggleBreakpoint,hcNoContext,
- nil))))));
- GetLocalMenu:=M;
- end;
- procedure TBreakpointListBox.HandleEvent(var Event: TEvent);
- var DontClear: boolean;
- begin
- case Event.What of
- evKeyDown :
- begin
- DontClear:=false;
- case Event.KeyCode of
- kbEnter :
- Message(@Self,evCommand,cmMsgGotoSource,nil);
- else
- DontClear:=true;
- end;
- if not DontClear then
- ClearEvent(Event);
- end;
- evBroadcast :
- case Event.Command of
- cmListItemSelected :
- if Event.InfoPtr=@Self then
- Message(@Self,evCommand,cmEdit,nil);
- end;
- evCommand :
- begin
- DontClear:=false;
- case Event.Command of
- cmMsgTrackSource :
- if Range>0 then
- TrackSource;
- cmEdit :
- EditCurrent;
- cmToggleBreakpoint :
- ToggleCurrent;
- cmDelete :
- DeleteCurrent;
- cmNew :
- EditNew;
- cmMsgClear :
- Clear;
- else
- DontClear:=true;
- end;
- if not DontClear then
- ClearEvent(Event);
- end;
- end;
- inherited HandleEvent(Event);
- end;
- procedure TBreakpointListBox.AddBreakpoint(P: PBreakpointItem);
- var W : integer;
- begin
- if List=nil then New(List, Init(20,20));
- W:=length(P^.GetText(255));
- if W>MaxWidth then
- begin
- MaxWidth:=W;
- if HScrollBar<>nil then
- HScrollBar^.SetRange(0,MaxWidth);
- end;
- List^.Insert(P);
- SetRange(List^.Count);
- if Focused=List^.Count-1-1 then
- FocusItem(List^.Count-1);
- DrawView;
- end;
- (* function TBreakpointListBox.AddModuleName(const Name: string): PString;
- var P: PString;
- begin
- if ModuleNames<>nil then
- P:=ModuleNames^.Add(Name)
- else
- P:=nil;
- AddModuleName:=P;
- end; *)
- function TBreakpointListBox.GetText(Item,MaxLen: Sw_Integer): String;
- var P: PBreakpointItem;
- S: string;
- begin
- P:=List^.At(Item);
- S:=P^.GetText(MaxLen);
- GetText:=copy(S,1,MaxLen);
- end;
-
- procedure TBreakpointListBox.Clear;
- begin
- if assigned(List) then
- Dispose(List, Done);
- List:=nil;
- MaxWidth:=0;
- (* if assigned(ModuleNames) then
- ModuleNames^.FreeAll; *)
- SetRange(0); DrawView;
- Message(Application,evBroadcast,cmClearLineHighlights,@Self);
- end;
- procedure TBreakpointListBox.TrackSource;
- var W: PSourceWindow;
- P: PBreakpointItem;
- R: TRect;
- (* Row,Col: sw_integer; *)
- begin
- (*Message(Application,evBroadcast,cmClearLineHighlights,@Self);
- if Range=0 then Exit;*)
- P:=List^.At(Focused);
- if P^.GetModuleName='' then Exit;
- Desktop^.Lock;
- GetNextEditorBounds(R);
- R.B.Y:=Owner^.Origin.Y;
- W:=EditorWindowFile(P^.GetModuleName);
- if assigned(W) then
- begin
- W^.GetExtent(R);
- R.B.Y:=Owner^.Origin.Y;
- W^.ChangeBounds(R);
- W^.Editor^.SetCurPtr(1,P^.Breakpoint^.Line);
- end
- else
- W:=TryToOpenFile(@R,P^.GetModuleName,1,P^.Breakpoint^.Line,true);
- if W<>nil then
- begin
- W^.Select;
- W^.Editor^.TrackCursor(true);
- W^.Editor^.SetHighlightRow(P^.Breakpoint^.Line);
- end;
- if Assigned(Owner) then
- Owner^.Select;
- Desktop^.UnLock;
- end;
- procedure TBreakpointListBox.ToggleCurrent;
- var W: PSourceWindow;
- P: PBreakpointItem;
- b : boolean;
- (* Row,Col: sw_integer; *)
- begin
- if Range=0 then Exit;
- P:=List^.At(Focused);
- if P=nil then Exit;
- if P^.Breakpoint^.state=bs_enabled then
- P^.Breakpoint^.state:=bs_disabled
- else if P^.Breakpoint^.state=bs_disabled then
- P^.Breakpoint^.state:=bs_enabled;
- BreakpointCollection^.Update;
- if P^.Breakpoint^.typ=bt_file_line then
- begin
- W:=TryToOpenFile(nil,GetStr(P^.Breakpoint^.FileName),1,P^.Breakpoint^.Line,false);
- If assigned(W) then
- begin
- if P^.Breakpoint^.state=bs_enabled then
- b:=true
- else
- b:=false;
- W^.Editor^.SetLineBreakState(P^.Breakpoint^.Line,b);
- end;
- end;
- end;
- procedure TBreakpointListBox.EditCurrent;
- var
- P: PBreakpointItem;
- begin
- if Range=0 then Exit;
- P:=List^.At(Focused);
- if P=nil then Exit;
- Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P^.Breakpoint)),nil);
- BreakpointCollection^.Update;
- end;
- procedure TBreakpointListBox.DeleteCurrent;
- var
- P: PBreakpointItem;
- begin
- if Range=0 then Exit;
- P:=List^.At(Focused);
- if P=nil then Exit;
- BreakpointCollection^.free(P^.Breakpoint);
- List^.free(P);
- BreakpointCollection^.Update;
- end;
- procedure TBreakpointListBox.EditNew;
- var
- P: PBreakpoint;
- begin
- P:=New(PBreakpoint,Init_Empty);
- if Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P)),nil)<>cmCancel then
- begin
- BreakpointCollection^.Insert(P);
- BreakpointCollection^.Update;
- end
- else
- dispose(P,Done);
- end;
- procedure TBreakpointListBox.Draw;
- var
- I, J, Item: Sw_Integer;
- NormalColor, SelectedColor, FocusedColor, Color: Word;
- ColWidth, CurCol, Indent: Integer;
- B: TDrawBuffer;
- Text: String;
- SCOff: Byte;
- TC: byte;
- procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
- begin
- if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
- if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
- begin
- NormalColor := GetColor(1);
- FocusedColor := GetColor(3);
- SelectedColor := GetColor(4);
- end else
- begin
- NormalColor := GetColor(2);
- SelectedColor := GetColor(4);
- end;
- if Transparent then
- begin MT(NormalColor); MT(SelectedColor); end;
- if NoSelection then
- SelectedColor:=NormalColor;
- if HScrollBar <> nil then Indent := HScrollBar^.Value
- else Indent := 0;
- ColWidth := Size.X div NumCols + 1;
- for I := 0 to Size.Y - 1 do
- begin
- for J := 0 to NumCols-1 do
- begin
- Item := J*Size.Y + I + TopItem;
- CurCol := J*ColWidth;
- if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
- (Focused = Item) and (Range > 0) then
- begin
- Color := FocusedColor;
- SetCursor(CurCol+1,I);
- SCOff := 0;
- end
- else if (Item < Range) and IsSelected(Item) then
- begin
- Color := SelectedColor;
- SCOff := 2;
- end
- else
- begin
- Color := NormalColor;
- SCOff := 4;
- end;
- MoveChar(B[CurCol], ' ', Color, ColWidth);
- if Item < Range then
- begin
- Text := GetText(Item, ColWidth + Indent);
- Text := Copy(Text,Indent,ColWidth);
- MoveStr(B[CurCol+1], Text, Color);
- if ShowMarkers then
- begin
- WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
- WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
- end;
- end;
- MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
- end;
- WriteLine(0, I, Size.X, 1, B);
- end;
- end;
- (* constructor TBreakpointListBox.Load(var S: TStream);
- begin
- inherited Load(S);
- end;
- procedure TBreakpointListBox.Store(var S: TStream);
- var OL: PCollection;
- begin
- OL:=List;
- New(List, Init(1,1));
- inherited Store(S);
- Dispose(List, Done);
- List:=OL;
- { ^^^ nasty trick - has anyone a better idea how to avoid storing the
- collection? Pasting here a modified version of TListBox.Store+
- TAdvancedListBox.Store isn't a better solution, since by eventually
- changing the obj-hierarchy you'll always have to modify this, too - BG }
- end; *)
- destructor TBreakpointListBox.Done;
- begin
- inherited Done;
- if List<>nil then Dispose(List, Done);
- (* if ModuleNames<>nil then Dispose(ModuleNames, Done);*)
- end;
- {****************************************************************************
- TBreakpointsWindow
- ****************************************************************************}
- constructor TBreakpointsWindow.Init;
- var R,R2: TRect;
- HSB,VSB: PScrollBar;
- ST: PStaticText;
- S: String;
- X,X1 : Sw_integer;
- const White = 15;
- begin
- Desktop^.GetExtent(R); R.A.Y:=R.B.Y-18;
- inherited Init(R, 'Breakpoint list', wnNoNumber);
- HelpCtx:=hcBreakpointListWindow;
- GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1;
- S:=' Type | State | Position | Ignore | Conditions ';
- New(ST, Init(R,S));
- ST^.GrowMode:=gfGrowHiX;
- Insert(ST);
- GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,1); R.B.Y:=R.A.Y+1;
- New(ST, Init(R, CharStr('Ä', MaxViewWidth)));
- ST^.GrowMode:=gfGrowHiX;
- Insert(ST);
- GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);Dec(R.B.Y,5);
- R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
- New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
- R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
- New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
- New(BreakLB, Init(R,HSB,VSB));
- BreakLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
- BreakLB^.Transparent:=true;
- Insert(BreakLB);
- GetExtent(R);R.Grow(-1,-1);
- Dec(R.B.Y);
- R.A.Y:=R.B.Y-2;
- X:=(R.B.X-R.A.X) div 4;
- X1:=R.A.X+(X div 2);
- R.A.X:=X1-3;R.B.X:=X1+7;
- Insert(New(PButton, Init(R, '~C~lose', cmClose, bfDefault)));
- X1:=X1+X;
- R.A.X:=X1-3;R.B.X:=X1+7;
- Insert(New(PButton, Init(R, '~N~ew', cmNew, bfNormal)));
- X1:=X1+X;
- R.A.X:=X1-3;R.B.X:=X1+7;
- Insert(New(PButton, Init(R, '~E~dit', cmEdit, bfNormal)));
- X1:=X1+X;
- R.A.X:=X1-3;R.B.X:=X1+7;
- Insert(New(PButton, Init(R, '~D~elete', cmDelete, bfNormal)));
- BreakLB^.Select;
- Update;
- BreakpointsWindow:=@self;
- end;
- procedure TBreakpointsWindow.AddBreakpoint(ABreakpoint : PBreakpoint);
- begin
- BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(ABreakpoint)));
- end;
- procedure TBreakpointsWindow.ClearBreakpoints;
- begin
- BreakLB^.Clear;
- ReDraw;
- end;
- procedure TBreakpointsWindow.ReloadBreakpoints;
- procedure InsertInBreakLB(P : PBreakpoint);
- begin
- BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(P)));
- end;
- begin
- If not assigned(BreakpointCollection) then
- exit;
- BreakpointCollection^.ForEach(@InsertInBreakLB);
- ReDraw;
- end;
- procedure TBreakpointsWindow.SizeLimits(var Min, Max: TPoint);
- begin
- inherited SizeLimits(Min,Max);
- Min.X:=40; Min.Y:=18;
- end;
- procedure TBreakpointsWindow.Close;
- begin
- Hide;
- end;
- procedure TBreakpointsWindow.HandleEvent(var Event: TEvent);
- var DontClear : boolean;
- begin
- case Event.What of
- evCommand :
- begin
- DontClear:=False;
- case Event.Command of
- cmNew :
- BreakLB^.EditNew;
- cmEdit :
- BreakLB^.EditCurrent;
- cmDelete :
- BreakLB^.DeleteCurrent;
- cmClose :
- Hide;
- else
- DontClear:=true;
- end;
- if not DontClear then
- ClearEvent(Event);
- end;
- evBroadcast :
- case Event.Command of
- cmUpdate :
- Update;
- end;
- end;
- inherited HandleEvent(Event);
- end;
- procedure TBreakpointsWindow.Update;
- begin
- ClearBreakpoints;
- ReloadBreakpoints;
- end;
- destructor TBreakpointsWindow.Done;
- begin
- inherited Done;
- BreakpointsWindow:=nil;
- end;
- {****************************************************************************
- TBreakpointItemDialog
- ****************************************************************************}
- constructor TBreakpointItemDialog.Init(ABreakpoint: PBreakpoint);
- var R,R2,R3: TRect;
- Items: PSItem;
- I : BreakpointType;
- KeyCount: sw_integer;
- begin
- KeyCount:=longint(high(BreakpointType));
- R.Assign(0,0,60,Max(3+KeyCount,18));
- inherited Init(R,'Modify/New Breakpoint');
- Breakpoint:=ABreakpoint;
- GetExtent(R); R.Grow(-3,-2); R3.Copy(R);
- Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
- New(NameIL, Init(R, 128)); Insert(NameIL);
- R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, '~N~ame', NameIL)));
- R.Move(0,3);
- New(LineIL, Init(R, 128)); Insert(LineIL);
- LineIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
- R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, '~L~ine', LineIL)));
- R.Move(0,3);
- New(ConditionsIL, Init(R, 128)); Insert(ConditionsIL);
- R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, 'Conditions', ConditionsIL)));
- R.Move(0,3);
- New(IgnoreIL, Init(R, 128)); Insert(IgnoreIL);
- IgnoreIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
- R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, '~I~gnore count', IgnoreIL)));
- R.Copy(R3); Inc(R.A.X,38); R.B.Y:=R.A.Y+KeyCount;
- Items:=nil;
- for I:=high(BreakpointType) downto low(BreakpointType) do
- Items:=NewSItem(BreakpointTypeStr[I], Items);
- New(TypeRB, Init(R, Items));
- Insert(TypeRB);
- InsertButtons(@Self);
- NameIL^.Select;
- end;
- function TBreakpointItemDialog.Execute: Word;
- var R: word;
- S1: string;
- err: word;
- L: longint;
- begin
- R:=longint(Breakpoint^.typ);
- TypeRB^.SetData(R);
- If Breakpoint^.typ=bt_file_line then
- S1:=GetStr(Breakpoint^.FileName)
- else
- S1:=GetStr(Breakpoint^.name);
- NameIL^.SetData(S1);
- If Breakpoint^.typ=bt_file_line then
- S1:=IntToStr(Breakpoint^.Line)
- else
- S1:='0';
- LineIL^.SetData(S1);
- S1:=IntToStr(Breakpoint^.IgnoreCount);
- IgnoreIL^.SetData(S1);
- S1:=GetStr(Breakpoint^.Conditions);
- ConditionsIL^.SetData(S1);
- R:=inherited Execute;
- if R=cmOK then
- begin
- TypeRB^.GetData(R);
- L:=R;
- Breakpoint^.typ:=BreakpointType(L);
- NameIL^.GetData(S1);
- If Breakpoint^.typ=bt_file_line then
- begin
- If assigned(Breakpoint^.FileName) then
- DisposeStr(Breakpoint^.FileName);
- Breakpoint^.FileName:=NewStr(S1);
- end
- else
- begin
- If assigned(Breakpoint^.Name) then
- DisposeStr(Breakpoint^.Name);
- Breakpoint^.name:=NewStr(S1);
- end;
- If Breakpoint^.typ=bt_file_line then
- begin
- LineIL^.GetData(S1);
- Val(S1,L,err);
- Breakpoint^.Line:=L;
- end;
- IgnoreIL^.GetData(S1);
- Val(S1,L,err);
- Breakpoint^.IgnoreCount:=L;
- ConditionsIL^.GetData(S1);
- If assigned(Breakpoint^.Conditions) then
- DisposeStr(Breakpoint^.Conditions);
- Breakpoint^.Conditions:=NewStr(S1);
- end;
- Execute:=R;
- end;
- {****************************************************************************
- TWatch
- ****************************************************************************}
- constructor TWatch.Init(s : string);
- begin
- expr:=NewStr(s);
- last_value:=nil;
- current_value:=nil;
- Get_new_value;
- end;
- procedure TWatch.rename(s : string);
- begin
- if assigned(expr) then
- begin
- if GetStr(expr)=S then
- exit;
- DisposeStr(expr);
- end;
- expr:=NewStr(s);
- if assigned(last_value) then
- StrDispose(last_value);
- last_value:=nil;
- if assigned(current_value) then
- StrDispose(current_value);
- current_value:=nil;
- Get_new_value;
- end;
- procedure TWatch.Get_new_value;
- var p,q : pchar;
- i : longint;
- last_removed : boolean;
- begin
- If not assigned(Debugger) then
- exit;
- if assigned(last_value) then
- strdispose(last_value);
- last_value:=current_value;
- Debugger^.Command('p '+GetStr(expr));
- p:=strnew(Debugger^.GetOutput);
- if assigned(p) and (p[0]='$') then
- q:=StrPos(p,'=');
- if not assigned(q) then
- q:=p;
- i:=strlen(q);
- if q[i-1]=#10 then
- begin
- q[i-1]:=#0;
- last_removed:=true;
- end
- else
- last_removed:=false;
- current_value:=strnew(q);
- if last_removed then
- q[i-1]:=#10;
- strdispose(p);
- end;
- destructor TWatch.Done;
- begin
- if assigned(expr) then
- disposestr(expr);
- if assigned(last_value) then
- strdispose(last_value);
- if assigned(current_value) then
- strdispose(current_value);
- inherited done;
- end;
- {****************************************************************************
- TWatchesCollection
- ****************************************************************************}
- constructor TWatchesCollection.Init;
- begin
- inherited Init(10,10);
- end;
- procedure TWatchesCollection.Insert(Item: Pointer);
- begin
- PWatch(Item)^.Get_new_value;
- Inherited Insert(Item);
- Update;
- end;
- procedure TWatchesCollection.Update;
- var
- W,W1 : integer;
- procedure GetMax(P : PWatch);
- begin
- if assigned(P^.Current_value) then
- begin
- W1:=StrLen(P^.Current_value)+2+Length(GetStr(P^.expr));
- if W1>W then
- W:=W1;
- end;
- end;
- begin
- W:=0;
- ForEach(@GetMax);
- MaxW:=W;
- If assigned(WatchesWindow) then
- WatchesWindow^.WLB^.Update(MaxW);
- end;
- function TWatchesCollection.At(Index: Integer): PWatch;
- begin
- At:=Inherited At(Index);
- end;
- {****************************************************************************
- TWatchesListBox
- ****************************************************************************}
- (* PWatchesListBox = ^TWatchesListBox;
- TWatchesListBox = object(THSListBox)
- MaxWidth : Sw_integer; *)
- constructor TWatchesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
- begin
- inherited Init(Bounds,1,AHScrollBar,AVScrollBar);
- If assigned(List) then
- dispose(list,done);
- List:=WatchesCollection;
- end;
- procedure TWatchesListBox.Update(AMaxWidth : integer);
- begin
- MaxWidth:=AMaxWidth;
- if HScrollBar<>nil then
- HScrollBar^.SetRange(0,MaxWidth);
- SetRange(List^.Count);
- if Focused=List^.Count-1-1 then
- FocusItem(List^.Count-1);
- DrawView;
- end;
- function TWatchesListBox.GetIndentedText(Item,Indent,MaxLen: Sw_Integer): String;
- var
- PW : PWatch;
- ValOffset : Sw_integer;
- S : String;
- begin
- PW:=WatchesCollection^.At(Item);
- ValOffset:=Length(GetStr(PW^.Expr))+2;
- if Indent<ValOffset then
- begin
- if not assigned(PW^.current_value) then
- S:=' '+GetStr(PW^.Expr)+' <Unknown value>'
- else if not assigned(PW^.last_value) or
- (strcomp(PW^.Last_value,PW^.Current_value)=0) then
- S:=' '+GetStr(PW^.Expr)+' '+StrPas(PW^.Current_value)
- else
- S:='!'+GetStr(PW^.Expr)+'!'+StrPas(PW^.Current_value);
- GetIndentedText:=Copy(S,Indent,MaxLen);
- end
- else
- begin
- if not assigned(PW^.Current_value) or
- (StrLen(PW^.Current_value)<Indent-Valoffset) then
- S:=''
- else
- S:=StrPas(@(PW^.Current_Value[Indent-Valoffset]));
- GetIndentedText:=Copy(S,1,MaxLen);
- end;
- end;
- (* function TWatchesListBox.GetLocalMenu: PMenu;virtual;
- procedure TWatchesListBox.Clear; virtual;
- procedure TWatchesListBox.TrackSource; virtual;
- procedure TWatchesListBox.EditNew; virtual;
- procedure TWatchesListBox.EditCurrent; virtual;
- procedure TWatchesListBox.DeleteCurrent; virtual;
- procedure TWatchesListBox.ToggleCurrent; *)
- procedure TWatchesListBox.EditCurrent;
- var
- P: PWatch;
- begin
- if Range=0 then Exit;
- P:=WatchesCollection^.At(Focused);
- if P=nil then Exit;
- Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil);
- WatchesCollection^.Update;
- end;
- procedure TWatchesListBox.DeleteCurrent;
- var
- P: PWatch;
- begin
- if Range=0 then Exit;
- P:=WatchesCollection^.At(Focused);
- if P=nil then Exit;
- WatchesCollection^.free(P);
- WatchesCollection^.Update;
- end;
- procedure TWatchesListBox.EditNew;
- var
- P: PWatch;
- begin
- P:=New(PWatch,Init(''));
- if Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil)<>cmCancel then
- begin
- WatchesCollection^.Insert(P);
- WatchesCollection^.Update;
- end
- else
- dispose(P,Done);
- end;
- procedure TWatchesListBox.Draw;
- var
- I, J, Item: Sw_Integer;
- NormalColor, SelectedColor, FocusedColor, Color: Word;
- ColWidth, CurCol, Indent: Integer;
- B: TDrawBuffer;
- Text: String;
- SCOff: Byte;
- TC: byte;
- procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
- begin
- if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
- if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
- begin
- NormalColor := GetColor(1);
- FocusedColor := GetColor(3);
- SelectedColor := GetColor(4);
- end else
- begin
- NormalColor := GetColor(2);
- SelectedColor := GetColor(4);
- end;
- if Transparent then
- begin MT(NormalColor); MT(SelectedColor); end;
- (* if NoSelection then
- SelectedColor:=NormalColor;*)
- if HScrollBar <> nil then Indent := HScrollBar^.Value
- else Indent := 0;
- ColWidth := Size.X div NumCols + 1;
- for I := 0 to Size.Y - 1 do
- begin
- for J := 0 to NumCols-1 do
- begin
- Item := J*Size.Y + I + TopItem;
- CurCol := J*ColWidth;
- if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
- (Focused = Item) and (Range > 0) then
- begin
- Color := FocusedColor;
- SetCursor(CurCol+1,I);
- SCOff := 0;
- end
- else if (Item < Range) and IsSelected(Item) then
- begin
- Color := SelectedColor;
- SCOff := 2;
- end
- else
- begin
- Color := NormalColor;
- SCOff := 4;
- end;
- MoveChar(B[CurCol], ' ', Color, ColWidth);
- if Item < Range then
- begin
- (* Text := GetText(Item, ColWidth + Indent);
- Text := Copy(Text,Indent,ColWidth); *)
- Text:=GetIndentedText(Item,Indent,ColWidth);
- MoveStr(B[CurCol+1], Text, Color);
- if ShowMarkers then
- begin
- WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
- WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
- end;
- end;
- MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
- end;
- WriteLine(0, I, Size.X, 1, B);
- end;
- end;
- function TWatchesListBox.GetLocalMenu: PMenu;
- var M: PMenu;
- begin
- if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
- M:=NewMenu(
- NewItem('~E~dit watch','',kbNoKey,cmEdit,hcNoContext,
- NewItem('~N~ew watch','',kbNoKey,cmNew,hcNoContext,
- NewItem('~D~elete watch','',kbNoKey,cmDelete,hcNoContext,
- nil))));
- GetLocalMenu:=M;
- end;
- procedure TWatchesListBox.HandleEvent(var Event: TEvent);
- var DontClear: boolean;
- begin
- case Event.What of
- evKeyDown :
- begin
- DontClear:=false;
- case Event.KeyCode of
- kbEnter :
- Message(@Self,evCommand,cmEdit,nil);
- kbIns :
- Message(@Self,evCommand,cmNew,nil);
- kbDel :
- Message(@Self,evCommand,cmDelete,nil);
- else
- DontClear:=true;
- end;
- if not DontClear then
- ClearEvent(Event);
- end;
- evBroadcast :
- case Event.Command of
- cmListItemSelected :
- if Event.InfoPtr=@Self then
- Message(@Self,evCommand,cmEdit,nil);
- end;
- evCommand :
- begin
- DontClear:=false;
- case Event.Command of
- cmEdit :
- EditCurrent;
- cmDelete :
- DeleteCurrent;
- cmNew :
- EditNew;
- else
- DontClear:=true;
- end;
- if not DontClear then
- ClearEvent(Event);
- end;
- end;
- inherited HandleEvent(Event);
- end;
-
- (* constructor TWatchesListBox.Load(var S: TStream);
- procedure TWatchesListBox.Store(var S: TStream); *)
- destructor TWatchesListBox.Done;
- begin
- List:=nil;
- inherited Done;
- end;
- {****************************************************************************
- TWatchesWindow
- ****************************************************************************}
- Constructor TWatchesWindow.Init;
- var
- R : trect;
- begin
- Desktop^.GetExtent(R);
- R.A.Y:=R.B.Y-5;
- inherited Init(R, 'Watches', wnNoNumber);
- GetExtent(R);
- HelpCtx:=hcWatches;
- R.Grow(-1,-1);
- New(WLB,Init(R,nil,nil));
- WLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
- WLB^.Transparent:=true;
- Insert(WLB);
- If assigned(WatchesWindow) then
- dispose(WatchesWindow,done);
- WatchesWindow:=@Self;
- end;
- procedure TWatchesWindow.Update;
- begin
- WatchesCollection^.Update;
- Draw;
- end;
- Destructor TWatchesWindow.Done;
- begin
- WatchesWindow:=nil;
- Dispose(WLB,done);
- inherited done;
- end;
-
- {****************************************************************************
- TWatchItemDialog
- ****************************************************************************}
- (* TWatchItemDialog = object(TCenterDialog)
- constructor Init(AWatch: PWatch);
- function Execute: Word; virtual;
- private
- Watch : PWatch;
- NameIL : PInputLine;
- TextST : PAdvancedStaticText;
- CurrentIL: PLabel;
- LastIL : PLabel;
- end; *)
- constructor TWatchItemDialog.Init(AWatch: PWatch);
- var R,R2: TRect;
- begin
- R.Assign(0,0,50,10);
- inherited Init(R,'Edit Watch');
- Watch:=AWatch;
- GetExtent(R); R.Grow(-3,-2);
- Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
- New(NameIL, Init(R, 255)); Insert(NameIL);
- R2.Copy(R); R2.Move(-1,-1);
- Insert(New(PLabel, Init(R2, '~E~xpression to watch', NameIL)));
- GetExtent(R);
- R.Grow(-1,-1);
- R.A.Y:=R.A.Y+3;
- R.B.X:=R.A.X+36;
- TextST:=New(PAdvancedStaticText, Init(R, 'Watch values'));
- Insert(TextST);
- InsertButtons(@Self);
- NameIL^.Select;
- end;
- function TWatchItemDialog.Execute: Word;
- var R: word;
- S1,S2: string;
- err: word;
- L: longint;
- begin
- S1:=GetStr(Watch^.expr);
- NameIL^.SetData(S1);
- if assigned(Watch^.Current_value) then
- S1:=StrPas(Watch^.Current_value)
- else
- S1:='';
- if assigned(Watch^.Last_value) then
- S2:=StrPas(Watch^.Last_value)
- else
- S2:='';
- if assigned(Watch^.Last_value) and
- assigned(Watch^.Current_value) and
- (strcomp(Watch^.Last_value,Watch^.Current_value)=0) then
- S1:='Current value: '+#13+S1
- else
- S1:='Current value: '+#13+S1+#13+
- 'Previous value: '+#13+S2;
- TextST^.SetText(S1);
- R:=inherited Execute;
- if R=cmOK then
- begin
- NameIL^.GetData(S1);
- If assigned(Watch^.Expr) then
- DisposeStr(Watch^.Expr);
- Watch^.expr:=NewStr(S1);
- end;
- Execute:=R;
- end;
- {****************************************************************************
- Init/Final
- ****************************************************************************}
- procedure InitDebugger;
- begin
- {$ifdef DEBUG}
- Assign(gdb_file,'gdb$$$.out');
- Rewrite(gdb_file);
- Use_gdb_file:=true;
- {$endif}
- if (not ExistsFile(ExeFile)) or (CompilationPhase<>cpDone) then
- DoCompile(cRun);
- if CompilationPhase<>cpDone then
- Exit;
- if (EXEFile='') then
- begin
- ErrorBox('Oooops, nothing to debug.',nil);
- Exit;
- end;
- { init debugcontroller }
- if assigned(Debugger) then
- dispose(Debugger,Done);
- new(Debugger,Init(ExeFile));
- {$ifdef GDBWINDOW}
- InitGDBWindow;
- {$endif def GDBWINDOW}
- end;
- procedure DoneDebugger;
- begin
- if assigned(Debugger) then
- dispose(Debugger,Done);
- Debugger:=nil;
- {$ifdef DEBUG}
- If Use_gdb_file then
- Close(GDB_file);
- Use_gdb_file:=false;
- {$endif}
- {DoneGDBWindow;}
- end;
- procedure InitGDBWindow;
- var
- R : TRect;
- begin
- if GDBWindow=nil then
- begin
- DeskTop^.GetExtent(R);
- new(GDBWindow,init(R));
- DeskTop^.Insert(GDBWindow);
- end;
- end;
- procedure DoneGDBWindow;
- begin
- if assigned(GDBWindow) then
- begin
- DeskTop^.Delete(GDBWindow);
- GDBWindow:=nil;
- end;
- end;
- procedure InitBreakpoints;
- begin
- New(BreakpointCollection,init(10,10));
- end;
- procedure DoneBreakpoints;
- begin
- Dispose(BreakpointCollection,Done);
- BreakpointCollection:=nil;
- end;
- procedure InitWatches;
- begin
- New(WatchesCollection,init);
- end;
- procedure DoneWatches;
- begin
- Dispose(WatchesCollection,Done);
- WatchesCollection:=nil;
- end;
- end.
- {
- $Log$
- Revision 1.20 1999-07-10 01:24:14 pierre
- + First implementation of watches window
- Revision 1.19 1999/06/30 23:58:12 pierre
- + BreakpointsList Window implemented
- with Edit/New/Delete functions
- + Individual breakpoint dialog with support for all types
- ignorecount and conditions
- (commands are not yet implemented, don't know if this wolud be useful)
- awatch and rwatch have problems because GDB does not annotate them
- I fixed v4.16 for this
- Revision 1.18 1999/03/16 00:44:42 peter
- * forgotten in last commit :(
- Revision 1.17 1999/03/02 13:48:28 peter
- * fixed far problem is fpdebug
- * tile/cascading with message window
- * grep fixes
- Revision 1.16 1999/03/01 15:41:52 peter
- + Added dummy entries for functions not yet implemented
- * MenuBar didn't update itself automatically on command-set changes
- * Fixed Debugging/Profiling options dialog
- * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
- set
- * efBackSpaceUnindents works correctly
- + 'Messages' window implemented
- + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
- + Added TP message-filter support (for ex. you can call GREP thru
- GREP2MSG and view the result in the messages window - just like in TP)
- * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
- so topic search didn't work...
- * In FPHELP.PAS there were still context-variables defined as word instead
- of THelpCtx
- * StdStatusKeys() was missing from the statusdef for help windows
- + Topic-title for index-table can be specified when adding a HTML-files
- Revision 1.15 1999/02/20 15:18:29 peter
- + ctrl-c capture with confirm dialog
- + ascii table in the tools menu
- + heapviewer
- * empty file fixed
- * fixed callback routines in fpdebug to have far for tp7
- Revision 1.14 1999/02/16 12:47:36 pierre
- * GDBWindow does not popup on F7 or F8 anymore
- Revision 1.13 1999/02/16 10:43:54 peter
- * use -dGDB for the compiler
- * only use gdb_file when -dDEBUG is used
- * profiler switch is now a toggle instead of radiobutton
- Revision 1.12 1999/02/11 19:07:20 pierre
- * GDBWindow redesigned :
- normal editor apart from
- that any kbEnter will send the line (for begin to cursor)
- to GDB command !
- GDBWindow opened in Debugger Menu
- still buggy :
- -echo should not be present if at end of text
- -GDBWindow becomes First after each step (I don't know why !)
- Revision 1.11 1999/02/11 13:10:03 pierre
- + GDBWindow only with -dGDBWindow for now : still buggy !!
- Revision 1.10 1999/02/10 09:55:07 pierre
- + added OldValue and CurrentValue field for watchpoints
- + InitBreakpoints and DoneBreakpoints
- + MessageBox if GDB stops bacause of a watchpoint !
- Revision 1.9 1999/02/08 17:43:43 pierre
- * RestDebugger or multiple running of debugged program now works
- + added DoContToCursor(F4)
- * Breakpoints are now inserted correctly (was mainlyy a problem
- of directories)
- Revision 1.8 1999/02/05 17:21:52 pierre
- Invalid_line renamed InvalidSourceLine
- Revision 1.7 1999/02/05 13:08:41 pierre
- + new breakpoint types added
- Revision 1.6 1999/02/05 12:11:53 pierre
- + SourceDir that stores directories for sources that the
- compiler should not know about
- Automatically asked for addition when a new file that
- needed filedialog to be found is in an unknown directory
- Stored and retrieved from INIFile
- + Breakpoints conditions added to INIFile
- * Breakpoints insterted and removed at debin and end of debug session
- Revision 1.5 1999/02/04 17:54:22 pierre
- + several commands added
- Revision 1.4 1999/02/04 13:32:02 pierre
- * Several things added (I cannot commit them independently !)
- + added TBreakpoint and TBreakpointCollection
- + added cmResetDebugger,cmGrep,CmToggleBreakpoint
- + Breakpoint list in INIFile
- * Select items now also depend of SwitchMode
- * Reading of option '-g' was not possible !
- + added search for -Fu args pathes in TryToOpen
- + added code for automatic opening of FileDialog
- if source not found
- Revision 1.3 1999/02/02 16:41:38 peter
- + automatic .pas/.pp adding by opening of file
- * better debuggerscreen changes
- Revision 1.2 1999/01/22 18:14:09 pierre
- * adaptd to changes in gdbint and gdbcon for to /
- Revision 1.1 1999/01/22 10:24:03 peter
- * first debugger things
- }
|