fpc/ide/fpmdebug.inc

{
    $Id$
    This file is part of the Free Pascal Integrated Development Environment
    Copyright (c) 1998 by Berczi Gabor

    Debug menu entries

    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.

 **********************************************************************}

{$ifdef SUPPORT_REMOTE}
function GetRemoteString : string;
var
  St : string;
begin
  St:=RemoteSendCommand;
  If RemoteConfig<>'' then
    ReplaceStrI(St,'$CONFIG','-F '+RemoteConfig)
  else
    ReplaceStrI(St,'$CONFIG','');
  If RemoteIdent<>'' then
    ReplaceStrI(St,'$IDENT','-i '+RemoteIdent)
  else
    ReplaceStrI(St,'$IDENT','');
  ReplaceStrI(St,'$LOCALFILE',GDBFileName(ExeFile));
  ReplaceStrI(St,'$REMOTEDIR',RemoteDir);
  ReplaceStrI(St,'$REMOTEMACHINE',RemoteMachine);
  GetRemoteString:=st;
end;

procedure TIDEApp.TransferRemote;
var
  S,SendCommand : string;
  Executed : boolean;
begin
  SendCommand:=GetRemoteString;
  if SendCommand<>'' then
    begin
      s:='scp'+exeext;
      if LocateExeFile(s) then
        Executed:=DoExecute(s,SendCommand,'','','',exNormal)
      else
        Executed:=DoExecute('scp',SendCommand,'','','',exNormal);
      if Executed then
        begin
         if (DosError<>0) or (DosExitCode<>0) then
          ErrorBox(#3'Execution of'#13#3+s+' '+SendCommand+#13#3+
            'returned ('+inttostr(DosError)+','+inttostr(DosExitCode)+')',nil);
        end
      else
        ErrorBox(#3'Unable to execute'#13#3+s+' '+SendCommand,nil);

    end
  else
    ErrorBox(#3'Unable to transfer executable',nil);
end;
{$endif SUPPORT_REMOTE}

procedure TIDEApp.DoUserScreenWindow;
begin
  if UserScreenWindow=nil then
    begin
     New(UserScreenWindow, Init(UserScreen, SearchFreeWindowNo));
     Desktop^.Insert(UserScreenWindow);
    end;
  UserScreenWindow^.MakeFirst;
end;

procedure TIDEApp.DoCloseUserScreenWindow;
begin
  if Assigned(UserScreenWindow) then
    Message(UserScreenWindow,evCommand,cmClose,nil);
end;

procedure TIDEApp.DoUserScreen;
var Event : TEvent;
    ev    : TMouseEvent;
    Clear : Boolean;
begin
  if UserScreen=nil then
   begin
     ErrorBox(msg_userscreennotavailable,nil);
     Exit;
   end;

  ShowUserScreen;

  InitKeyBoard;
  if UseMouse Then
    InitMouse;
  repeat
    repeat
      Drivers.GetKeyEvent(Event);
      if (Event.What and EvKeyboard)=evNothing then
        Begin
          If UseMouse Then
            Begin  
              Drivers.GetMouseEvent(Event);
              if (Event.What and evMouse)=evNothing then
               GiveUpTimeSlice
              else
                Event.what:=evMouse;
            End;
        End
      else
        Event.what:=evkeyboard;
    until Event.What in [evKeyboard,evmouse];
    if event.what=evmouse then
      Clear:=false
    else
      begin
        Clear:=true;
        if not UserScreen^.CanScroll then
          Clear:=false
       else
        case Event.keycode of
          kbPgUp : UserScreen^.Scroll(-20);
          kbPgDn : UserScreen^.Scroll(20);
          kbUp : UserScreen^.Scroll(-1);
          kbDown : UserScreen^.Scroll(1);
          kbHome : UserScreen^.Scroll(-1024);
          kbEnd : UserScreen^.Scroll(+1024);
        else
           Clear:=false;
        end;
      end;
    if Clear then
      ClearEvent(Event);
  until Event.what in [evKeyboard,evmouse];
  while (Keyboard.PollKeyEvent<>0) do
          Keyboard.GetKeyEvent;
  if UseMouse Then
    Begin
     while PollMouseEvent(Ev) do
       GetMouseEvent(ev);
     donemouse;
    End;
  DoneKeyboard;

  ShowIDEScreen;
end;

procedure TIDEApp.DoShowCallStack;
begin
{$ifdef NODEBUG}
  NoDebugger;
{$else}
  If not assigned(StackWindow) then
    InitStackWindow
  else
    StackWindow^.MakeFirst;
{$endif NODEBUG}
end;


procedure TIDEApp.DoShowDisassembly;
begin
{$ifdef NODEBUG}
  NoDebugger;
{$else}
  If not assigned(DisassemblyWindow) then
    InitDisassemblyWindow
  else
    DisassemblyWindow^.MakeFirst;
  DisassemblyWindow^.LoadFunction('');
{$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.DoShowFPU;
begin
{$ifdef NODEBUG}
  NoDebugger;
{$else}
  If not assigned(FPUWindow) then
    InitFPUWindow
  else
    FPUWindow^.MakeFirst;
{$endif NODEBUG}
end;


procedure TIDEApp.DoShowVector;
begin
{$ifdef NODEBUG}
  NoDebugger;
{$else}
  If not assigned(VectorWindow) then
    InitVectorWindow
  else
    VectorWindow^.MakeFirst;
{$endif NODEBUG}
end;

procedure TIDEApp.DoShowBreakpointList;
begin
{$ifdef NODEBUG}
  NoDebugger;
{$else}
  If assigned(BreakpointsWindow) then
    begin
      BreakpointsWindow^.Update;
      BreakpointsWindow^.Show;
      BreakpointsWindow^.MakeFirst;
    end
  else
    begin
      New(BreakpointsWindow,Init);
      Desktop^.Insert(BreakpointsWindow);
    end;
{$endif NODEBUG}
end;

procedure TIDEApp.DoShowWatches;
begin
{$ifdef NODEBUG}
  NoDebugger;
{$else}
  If assigned(WatchesWindow) then
    begin
      WatchesWindow^.Update;
      WatchesWindow^.MakeFirst;
    end
  else
    begin
      New(WatchesWindow,Init);
      Desktop^.Insert(WatchesWindow);
    end;
{$endif NODEBUG}
end;

procedure TIDEApp.DoAddWatch;
{$ifdef NODEBUG}
begin
  NoDebugger;
end;
{$else}
var
  P: PWatch;
  EditorWindow : PSourceWindow;
  EditorWasFirst : boolean;
  S : string;
begin
  EditorWindow:=FirstEditorWindow;
  { Leave the editor first, but only if there was already an WatchesWindow }
  EditorWasFirst:=(PWindow(Desktop^.First)=PWindow(EditorWindow)) and
                  assigned(WatchesWindow);
  If assigned(EditorWindow) then
    S:={LowerCaseStr(}EditorWindow^.Editor^.GetCurrentWord
  else
    S:='';
  P:=New(PWatch,Init(S));
  if ExecuteDialog(New(PWatchItemDialog,Init(P)),nil)<>cmCancel then
    begin
      WatchesCollection^.Insert(P);
      WatchesCollection^.Update;
      DoShowWatches;
      if EditorWasFirst then
       EditorWindow^.MakeFirst;
    end
  else
    dispose(P,Done);
end;
{$endif NODEBUG}

{
  $Log$
  Revision 1.10  2005-04-04 03:59:13  marco
   * fix for 3194: Use mouse to exit output screen

  Revision 1.9  2005/02/14 17:13:18  peter
    * truncate log

  Revision 1.8  2005/01/08 11:43:18  florian
    + vector unit window

  Revision 1.7  2005/01/07 21:52:23  florian
    * proper stepping in disassembler window now possible
    + disassembler window to menu added

}