Bläddra i källkod

+ added a register window, doesn't work yet

florian 25 år sedan
förälder
incheckning
7ff307fb8d
5 ändrade filer med 213 tillägg och 24 borttagningar
  1. 7 2
      ide/text/fpconst.pas
  2. 176 16
      ide/text/fpdebug.pas
  3. 5 1
      ide/text/fphelp.pas
  4. 9 3
      ide/text/fpide.pas
  5. 16 2
      ide/text/fpmdebug.inc

+ 7 - 2
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
 
-}
+}

+ 176 - 16
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
 
-}
+}

+ 5 - 1
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

+ 9 - 3
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
 
-}
+}

+ 16 - 2
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
 
-}
+}