freepascal.compiler/ide/text/fpdebug.pas

{
    $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 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;

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;

procedure InitDebugger;
procedure DoneDebugger;
procedure InitGDBWindow;
procedure DoneGDBWindow;
procedure InitBreakpoints;
procedure DoneBreakpoints;

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;
end;

procedure TDebugController.InsertBreakpoints;
  procedure DoInsert(PB : PBreakpoint);
  begin
    PB^.Insert;
  end;

begin
  BreakpointCollection^.ForEach(@DoInsert);
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 somethnig 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;
  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);
          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);
          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);
              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(stop_breakpoint_number);
      { 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;                                                                                                                                                                                                                     
  (* New(ModuleNames, Init(50,100)); *)
  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 W: PSourceWindow;
    P: PBreakpointItem;
    Row,Col: sw_integer;
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 W: PSourceWindow;
    P: PBreakpointItem;
    Row,Col: sw_integer;
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 W: PSourceWindow;
    P: PBreakpoint;
    Row,Col: sw_integer;
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;
    W,H : Sw_integer;
    X   : Sw_integer;
    X1,X2,X3: 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;

{****************************************************************************
                         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;

end.

{
  $Log$
  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

}