calstkwn.pas

Turbo Pascal 6.0编译器源码

unit CalStkWn;

{$O+,F+,S-,X+}

interface

uses Objects, Drivers, Views;

const

  CCallStackViewer = #6#6#7#6#6;

type

  PCallStackViewer = ^TCallStackViewer;
  TCallStackViewer = object(TListViewer)
    constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
    function GetPalette: PPalette; virtual;
    function GetText(Item: Integer; MaxLen: Integer): string; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure SelectItem(Item: Integer); virtual;
    function Valid(Command: Word): Boolean; virtual;
  end;

const

  RCallStackViewer: TStreamRec = (
    ObjType: 9001;
    VmtLink: Ofs(TypeOf(TCallStackViewer)^);
    Load:    @TCallStackViewer.Load;
    Store:@TCallStackViewer.Store
  );

function CallStackWindow: PWindow;

implementation

uses TVars, TWindows, Compiler, Editor, Context;

constructor TCallStackViewer.Init(var Bounds: TRect;
  AHScrollBar, AVScrollBar: PScrollBar);
begin
  TListViewer.Init(Bounds, 1, AHScrollBar, AVScrollBar);
  GrowMode := gfGrowHiX + gfGrowHiY;
  EventMask:=EventMask or evDebugger;
  HScrollBar^.SetRange(1, 128);
end;

function TCallStackViewer.GetPalette: PPalette;
const
  P: string[Length(CCallStackViewer)] = CCallStackViewer;
begin
  GetPalette := @P;
end;

function TCallStackViewer.GetText(Item: Integer; MaxLen: Integer): string;
var
  S: string;
begin
  GetCallStackEntry(Item + 1, S);
  GetText := S;
end;

procedure TCallStackViewer.HandleEvent(var Event: TEvent);
begin
  TListViewer.HandleEvent(Event);
  if Event.What and evMessage <> 0 then
    case Event.Command of
      cmFindCallStackWindow:
        ClearEvent(Event);
      cmRefreshInfo:
        begin
          SetRange(GetCallStackSize);
          DrawView;
        end;
      cmOK:
        begin
          Event.What := evCommand;
          Event.Command := cmViewSource;
          Event.InfoInt := Focused;
          PutEvent(Event);
        end;
      cmViewSource:
        begin
          if Focused < Range then
            SelectItem(Focused);
          ClearEvent(Event);
        end;
    end;
end;

procedure TCallStackViewer.SelectItem(Item: Integer);
var
  T: TPoint;
begin
  Longint(T) := GetCallStackPos(Item + 1);
  GoFileLine(GetSourceName(T.X)^, T.Y, gfAlways + gfProgram);
end;

function TCallStackViewer.Valid(Command: Word): Boolean;
begin
  SetRange(GetCallStackSize);
  Valid := True;
end;

function CallStackWindow: PWindow;
var
  R: TRect;
  Window: PWindow;
begin
  R.Assign(0, 16, 80, 23);
  Window := New(PTurboWindow, Init(R, 'Call stack', wnNoNumber, wpCallStackWindow));
  with Window^ do
  begin
    HelpCtx := hcCallStackWindow;
    Flags := Flags or (wfPutOnBottom + wfSaveable);
    GetExtent(R);
    R.Grow(-1, -1);
    Insert(New(PCallStackViewer, Init(R, StandardScrollBar(sbHorizontal),
      StandardScrollBar(sbVertical))));
  end;
  CallStackWindow := Window;
end;

end.