diff --git a/ide/text/fpconst.pas b/ide/text/fpconst.pas index 827c67cc92..0836ef1e4a 100644 --- a/ide/text/fpconst.pas +++ b/ide/text/fpconst.pas @@ -131,6 +131,7 @@ const { and why aren't these defines then removed? Gabor } cmCopyWin = 240; cmPasteWin = 241; + cmRegisters = 242; cmNotImplemented = 1000; cmNewFromTemplate = 1001; @@ -314,6 +315,7 @@ const hcGrep = hcShift+cmGrep; hcStack = hcShift+cmStack; hcBreakPointList = hcShift+cmBreakpointList; + hcRegisters = hcShift+cmRegisters; hcOpenAtCursor = hcShift+cmOpenAtCursor; hcBrowseAtCursor = hcShift+cmBrowseAtCursor; @@ -372,7 +374,10 @@ implementation END. { $Log$ - Revision 1.31 2000-01-03 11:38:33 michael + Revision 1.32 2000-01-08 18:26:20 florian + + added a register window, doesn't work yet + + Revision 1.31 2000/01/03 11:38:33 michael Changes from Gabor Revision 1.30 1999/11/03 09:39:23 peter @@ -561,4 +566,4 @@ END. + options are now written/read + find and replace routines -} +} \ No newline at end of file diff --git a/ide/text/fpdebug.pas b/ide/text/fpdebug.pas index 440315148b..46a54debdf 100644 --- a/ide/text/fpdebug.pas +++ b/ide/text/fpdebug.pas @@ -244,12 +244,33 @@ type destructor Done; virtual; end; + PRegistersView = ^TRegistersView; + TRegistersView = object(TView) + constructor Init(var Bounds: TRect); + procedure Draw;virtual; + destructor Done; virtual; + end; + + PRegistersWindow = ^TRegistersWindow; + TRegistersWindow = Object(TWindow) + RV : PRegistersView; + Constructor Init; + constructor Load(var S: TStream); + procedure Store(var S: TStream); + procedure Update; virtual; + destructor Done; virtual; + end; + const StackWindow : PStackWindow = nil; + RegistersWindow : PRegistersWindow = nil; procedure InitStackWindow; procedure DoneStackWindow; + procedure InitRegistersWindow; + procedure DoneRegistersWindow; + const BreakpointTypeStr : Array[BreakpointType] of String[9] @@ -274,6 +295,8 @@ procedure DoneWatches; procedure RegisterFPDebugViews; +procedure UpdateDebugViews; + implementation uses @@ -354,10 +377,34 @@ const Store: @TWatchesCollection.Store ); + RRegistersWindow: TStreamRec = ( + ObjType: 1711; + VmtLink: Ofs(TypeOf(TRegistersWindow)^); + Load: @TRegistersWindow.Load; + Store: @TRegistersWindow.Store + ); + + RRegistersView: TStreamRec = ( + ObjType: 1712; + VmtLink: Ofs(TypeOf(TRegistersView)^); + Load: @TRegistersView.Load; + Store: @TRegistersView.Store + ); + + {**************************************************************************** TDebugController ****************************************************************************} +procedure UpdateDebugViews; + + begin + If assigned(StackWindow) then + StackWindow^.Update; + If assigned(RegistersWindow) then + RegistersWindow^.Update; + end; + constructor TDebugController.Init(const exefn:string); var f: string; begin @@ -444,8 +491,7 @@ begin inherited Run; DebuggerScreen; IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],true); - If assigned(StackWindow) then - StackWindow^.Update; + UpdateDebugViews; end; procedure TDebugController.Continue; @@ -457,16 +503,14 @@ begin Run else inherited Continue; - If assigned(StackWindow) then - StackWindow^.Update; + UpdateDebugViews; {$endif NODEBUG} end; procedure TDebugController.UntilReturn; begin Command('finish'); - If assigned(StackWindow) then - StackWindow^.Update; + UpdateDebugViews; { We could try to get the return value ! Not done yet } end; @@ -534,8 +578,7 @@ begin begin errornb:=error_num; ReadWatches; - If assigned(StackWindow) then - StackWindow^.Update; + UpdateDebugViews; ErrorBox(#3'Error within GDB'#13#3'Error code = %d',@errornb); end; end; @@ -563,8 +606,7 @@ begin W^.Editor^.TrackCursor(true); W^.Editor^.SetDebuggerRow(Line); ReadWatches; - If assigned(StackWindow) then - StackWindow^.Update; + UpdateDebugViews; if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then W^.Select; @@ -580,8 +622,7 @@ begin begin W^.Editor^.SetDebuggerRow(Line); W^.Editor^.TrackCursor(true); - If assigned(StackWindow) then - StackWindow^.Update; + UpdateDebugViews; ReadWatches; if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then W^.Select; @@ -606,8 +647,7 @@ begin W^.Editor^.SetDebuggerRow(Line); W^.Editor^.TrackCursor(true); ReadWatches; - If assigned(StackWindow) then - StackWindow^.Update; + UpdateDebugViews; if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then W^.Select; LastSource:=W; @@ -2073,6 +2113,9 @@ end; begin inherited Load(S); GetSubViewPtr(S,WLB); + If assigned(WatchesWindow) then + dispose(WatchesWindow,done); + WatchesWindow:=@Self; end; procedure TWatchesWindow.Store(var S: TStream); @@ -2155,6 +2198,97 @@ begin Execute:=R; end; +{**************************************************************************** + TRegistersWindow +****************************************************************************} + + constructor TRegistersView.Init(var Bounds: TRect); + + begin + inherited init(Bounds); + end; + + procedure TRegistersView.Draw; + + var + p : pchar; + s : string; + + begin + inherited draw; + If not assigned(Debugger) then + exit; +{$ifndef NODEBUG} + Debugger^.Command('info registers'); + if Debugger^.Error then + p:=StrNew(Debugger^.GetError) + else + begin + p:=StrNew(Debugger^.GetOutput); + end; + { do not open a messagebox for such errors } + Debugger^.got_error:=false; +{$endif} + end; + + destructor TRegistersView.Done; + + begin + inherited done; + end; + + constructor TRegistersWindow.Init; + + var + R : TRect; + + begin + Desktop^.GetExtent(R); + R.A.X:=R.B.X-24; + R.B.Y:=8; + inherited Init(R,' Register View', wnNoNumber); + Flags:=wfClose or wfMove; + Palette:=wpCyanWindow; + HelpCtx:=hcRegisters; + R.Grow(-2,-2); + R.Move(1,1); + RV:=new(PRegistersView,init(R)); + Insert(RV); + If assigned(RegistersWindow) then + dispose(RegistersWindow,done); + RegistersWindow:=@Self; + Update; + end; + + constructor TRegistersWindow.Load(var S: TStream); + + begin + inherited load(S); + GetSubViewPtr(S,RV); + If assigned(RegistersWindow) then + dispose(RegistersWindow,done); + RegistersWindow:=@Self; + end; + + procedure TRegistersWindow.Store(var S: TStream); + + begin + inherited Store(s); + PutSubViewPtr(S,RV); + end; + + procedure TRegistersWindow.Update; + + begin + DrawView; + end; + + destructor TRegistersWindow.Done; + + begin + RegistersWindow:=nil; + inherited done; + end; {**************************************************************************** TStackWindow @@ -2271,6 +2405,9 @@ end; begin inherited Load(S); GetSubViewPtr(S,FLB); + If assigned(StackWindow) then + dispose(StackWindow,done); + StackWindow:=@Self; end; procedure TStackWindow.Store(var S: TStream); @@ -2368,6 +2505,24 @@ begin end; end; +procedure InitRegistersWindow; +begin + if RegistersWindow=nil then + begin + new(RegistersWindow,init); + DeskTop^.Insert(RegistersWindow); + end; +end; + +procedure DoneRegistersWindow; +begin + if assigned(RegistersWindow) then + begin + DeskTop^.Delete(RegistersWindow); + RegistersWindow:=nil; + end; +end; + procedure InitBreakpoints; begin New(BreakpointsCollection,init(10,10)); @@ -2402,13 +2557,18 @@ begin RegisterType(RWatch); RegisterType(RBreakpointCollection); RegisterType(RWatchesCollection); + RegisterType(RRegistersWindow); + RegisterType(RRegistersView); end; end. { $Log$ - Revision 1.36 1999-12-20 14:23:16 pierre + Revision 1.37 2000-01-08 18:26:20 florian + + added a register window, doesn't work yet + + Revision 1.36 1999/12/20 14:23:16 pierre * MyApp renamed IDEApp * TDebugController.ResetDebuggerRows added to get resetting of debugger rows @@ -2616,4 +2776,4 @@ end. Revision 1.1 1999/01/22 10:24:03 peter * first debugger things -} +} \ No newline at end of file diff --git a/ide/text/fphelp.pas b/ide/text/fphelp.pas index 677520b77c..3a16e39166 100644 --- a/ide/text/fphelp.pas +++ b/ide/text/fphelp.pas @@ -166,6 +166,7 @@ begin hcCalculator : S:='Show calculator'; hcGrep : S:='Run grep'; hcMsgGotoSource : S:='Edit source'; + hcRegisters : S:='Open the Registers Window'; hcToolsMessages : S:='Open the message window'; hcToolsBase.. @@ -410,7 +411,10 @@ end; END. { $Log$ - Revision 1.25 2000-01-05 17:25:26 pierre + Revision 1.26 2000-01-08 18:26:20 florian + + added a register window, doesn't work yet + + Revision 1.25 2000/01/05 17:25:26 pierre * typo error corrected Revision 1.24 2000/01/03 11:38:33 michael diff --git a/ide/text/fpide.pas b/ide/text/fpide.pas index 73eb3cb144..53768c880b 100644 --- a/ide/text/fpide.pas +++ b/ide/text/fpide.pas @@ -79,6 +79,7 @@ type procedure DoShowBreakpointList; procedure DoShowWatches; procedure DoAddWatch; + procedure DoShowRegisters; procedure DoInformation; procedure Messages; @@ -295,12 +296,13 @@ begin NewItem('~U~ser screen','Alt+F5', kbAltF5, cmUserScreen, hcUserScreen, NewItem('~B~reakpoint','Ctrl+F8', kbCtrlF8, cmToggleBreakpoint, hcToggleBreakpoint, NewItem('~C~all stack','Ctrl+F3', kbCtrlF3, cmStack, hcStack, + NewItem('~R~egisters','', kbNoKey, cmRegisters, hcRegisters, NewItem('~A~dd Watch','Ctrl+F7', kbCtrlF7, cmAddWatch, hcAddWatch, NewItem('~W~atches','', kbNoKey, cmWatches, hcWatches, NewItem('Breakpoint ~L~ist','', kbNoKey, cmBreakpointList, hcBreakpointList, NewLine( NewItem('~G~DB window','', kbNoKey, cmOpenGDBWindow, hcOpenGDBWindow, - nil)))))))))), + nil))))))))))), NewSubMenu('~T~ools', hcToolsMenu, NewMenu( NewItem('~M~essages', 'F11', kbF11, cmToolsMessages, hcToolsMessages, NewItem('Goto ~n~ext','Alt+F8', kbAltF8, cmToolsMsgNext, hcToolsMsgNext, @@ -493,6 +495,7 @@ begin cmWatches : DoShowWatches; cmAddWatch : DoAddWatch; cmOpenGDBWindow : DoOpenGDBWindow; + cmRegisters : DoShowRegisters; { -- Options menu -- } cmSwitchesMode : SetSwitchesMode; cmCompiler : DoCompilerSwitch; @@ -869,7 +872,10 @@ end; END. { $Log$ - Revision 1.49 2000-01-05 00:31:50 pierre + Revision 1.50 2000-01-08 18:26:20 florian + + added a register window, doesn't work yet + + Revision 1.49 2000/01/05 00:31:50 pierre * avoid new files to use TABS Revision 1.48 2000/01/03 11:38:33 michael @@ -1132,4 +1138,4 @@ END. + options are now written/read + find and replace routines -} +} \ No newline at end of file diff --git a/ide/text/fpmdebug.inc b/ide/text/fpmdebug.inc index 5566c8b8a8..8a562f3e76 100644 --- a/ide/text/fpmdebug.inc +++ b/ide/text/fpmdebug.inc @@ -59,6 +59,17 @@ begin {$endif NODEBUG} end; +procedure TIDEApp.DoShowRegisters; +begin +{$ifdef NODEBUG} + NoDebugger; +{$else} + If not assigned(RegistersWindow) then + InitRegistersWindow + else + RegistersWindow^.MakeFirst; +{$endif NODEBUG} +end; procedure TIDEApp.DoShowBreakpointList; begin {$ifdef NODEBUG} @@ -125,7 +136,10 @@ end; { $Log$ - Revision 1.9 1999-09-22 16:18:19 pierre + Revision 1.10 2000-01-08 18:26:20 florian + + added a register window, doesn't work yet + + Revision 1.9 1999/09/22 16:18:19 pierre + TIDEApp.DoCloseUserScreenWindow Revision 1.8 1999/09/09 14:20:05 pierre @@ -166,4 +180,4 @@ end; + Switches updated + Run program -} +} \ No newline at end of file