Merge branch 'debugcallstack'

Components/UniPs

@@ -1 +1 @@
-Subproject commit bcf0f1b1b718f52006d518866ed82e04760b79c7
+Subproject commit 1f846a56c81997b5cafe20d8dbd2234a88314a63

Projects/CompForm.dfm

@@ -60,6 +60,21 @@ object CompileForm: TCompileForm
       FullRepaint = False
       TabOrder = 0
       Visible = False
+      object DebugCallStackList: TListBox
+        Left = 0
+        Top = 0
+        Width = 361
+        Height = 83
+        Style = lbOwnerDrawFixed
+        Align = alClient
+        BorderStyle = bsNone
+        ItemHeight = 13
+        MultiSelect = True
+        PopupMenu = ListPopupMenu
+        TabOrder = 2
+        Visible = False
+        OnDrawItem = DebugCallStackListDrawItem
+      end
       object DebugOutputList: TListBox
         Left = 0
         Top = 0
@@ -98,7 +113,8 @@ object CompileForm: TCompileForm
         TabIndex = 0
         Tabs.Strings = (
           'Compiler Output'
-          'Debug Output')
+          'Debug Output'
+          'Debug Call Stack')
         OnClick = TabSetClick
       end
     end
@@ -436,6 +452,11 @@ object CompileForm: TCompileForm
         RadioItem = True
         OnClick = VDebugOutputClick
       end
+      object VDebugCallStack: TMenuItem
+        Caption = 'Debug &Call Stack'
+        RadioItem = True
+        OnClick = VDebugCallStackClick
+      end
       object VHide: TMenuItem
         Caption = '&Hide Bottom Pane'
         RadioItem = True

Projects/CompForm.pas

@@ -174,6 +174,8 @@ type
     ToolBarImageCollection: TImageCollection;
     ToolBarVirtualImageList: TVirtualImageList;
     PListSelectAll: TMenuItem;
+    DebugCallStackList: TListBox;
+    VDebugCallStack: TMenuItem;
     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     procedure FExitClick(Sender: TObject);
     procedure FOpenClick(Sender: TObject);
@@ -255,6 +257,9 @@ type
     procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
       NewDPI: Integer);
     procedure PListSelectAllClick(Sender: TObject);
+    procedure DebugCallStackListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
+      State: TOwnerDrawState);
+    procedure VDebugCallStackClick(Sender: TObject);
   private
     { Private declarations }
     FCompilerVersion: PCompilerVersionInfo;
@@ -324,10 +329,11 @@ type
     FProgress, FProgressMax: Cardinal;
     FProgressThemeData: HTHEME;
     FProgressChunkSize, FProgressSpaceSize: Integer;
-    FDebugLogListTimeWidth: Integer;
+    FDebugLogListTimestampsWidth: Integer;
     FBreakPoints: TList;
     FOnPendingSquiggly: Boolean;
     FPendingSquigglyCaretPos: Integer;
+    FCallStackCount: Cardinal;
     class procedure AppOnException(Sender: TObject; E: Exception);
     procedure AppOnActivate(Sender: TObject);
     procedure AppOnIdle(Sender: TObject; var Done: Boolean);
@@ -339,6 +345,7 @@ type
     function ConfirmCloseFile(const PromptToSave: Boolean): Boolean;
     procedure DebuggingStopped(const WaitForTermination: Boolean);
     procedure DebugLogMessage(const S: String);
+    procedure DebugShowCallStack(const CallStack: String; const CallStackCount: Cardinal);
     procedure DestroyDebugInfo;
     procedure DetachDebugger;
     function EvaluateConstant(const S: String; var Output: String): Integer;
@@ -392,7 +399,7 @@ type
     procedure UpdateEditModePanel;
     procedure UpdateLineMarkers(const Line: Integer);
     procedure UpdateNewButtons;
-    procedure UpdateOutputListsItemHeightAndDebugTimeWidth;
+    procedure UpdateTabSetListsItemHeightAndDebugTimeWidth;
     procedure UpdateRunMenu;
     procedure UpdateTargetMenu;
     procedure UpdateTheme;
@@ -408,6 +415,7 @@ type
     procedure WMDebuggerSteppedIntermediate(var Message: TMessage); message WM_Debugger_SteppedIntermediate;
     procedure WMDebuggerException(var Message: TMessage); message WM_Debugger_Exception;
     procedure WMDebuggerSetForegroundWindow(var Message: TMessage); message WM_Debugger_SetForegroundWindow;
+    procedure WMDebuggerCallStackCount(var Message: TMessage); message WM_Debugger_CallStackCount;
     procedure WMStartCommandLineCompile(var Message: TMessage); message WM_StartCommandLineCompile;
     procedure WMStartCommandLineWizard(var Message: TMessage); message WM_StartCommandLineWizard;
     procedure WMStartNormally(var Message: TMessage); message WM_StartNormally;
@@ -473,6 +481,7 @@ const
   { Tab set indexes }
   tiCompilerOutput = 0;
   tiDebugOutput = 1;
+  tiDebugCallStack = 2;
 
   { Memo marker numbers }
   mmIconHasEntry = 0;        { grey dot }
@@ -941,7 +950,7 @@ begin
 
   FBreakPoints := TList.Create;
 
-  UpdateOutputListsItemHeightAndDebugTimeWidth;
+  UpdateTabSetListsItemHeightAndDebugTimeWidth;
 
   Application.HintShortPause := 0;
   Application.OnException := AppOnException;
@@ -1041,7 +1050,7 @@ end;
 procedure TCompileForm.FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
   NewDPI: Integer);
 begin
-  UpdateOutputListsItemHeightAndDebugTimeWidth;
+  UpdateTabSetListsItemHeightAndDebugTimeWidth;
   UpdateStatusPanelHeight(StatusPanel.Height);
 end;
 
@@ -1073,6 +1082,7 @@ begin
       case TabSet.TabIndex of
         tiCompilerOutput: ActiveControl := CompilerOutputList;
         tiDebugOutput: ActiveControl := DebugOutputList;
+        tiDebugCallStack: ActiveControl := DebugCallStackList;
       end;
     end;
   end;
@@ -1454,73 +1464,53 @@ begin
   end;
 end;
 
-procedure TCompileForm.StatusMessage(const Kind: TStatusMessageKind; const S: String);
-var
-  DC: HDC;
-  Size: TSize;
-begin
-  with CompilerOutputList do begin
-    try
-      TopIndex := Items.AddObject(S, TObject(Kind));
-    except
-      on EOutOfResources do begin
-        Clear;
-        SendMessage(Handle, LB_SETHORIZONTALEXTENT, 0, 0);
-        Items.Add(SCompilerStatusReset);
-        TopIndex := Items.Add(S);
-      end;
-    end;
-    DC := GetDC(0);
-    try
-      SelectObject(DC, Font.Handle);
-      GetTextExtentPoint(DC, PChar(S), Length(S), Size);
-    finally
-      ReleaseDC(0, DC);
-    end;
-    Inc(Size.cx, 5);
-    if Size.cx > SendMessage(Handle, LB_GETHORIZONTALEXTENT, 0, 0) then
-      SendMessage(Handle, LB_SETHORIZONTALEXTENT, Size.cx, 0);
-    Update;
-  end;
-end;
+type
+  TAddLinesPrefix = (alpNone, alpTimestamp, alpCountdown);
 
-procedure TCompileForm.DebugLogMessage(const S: String);
+procedure AddLines(const ListBox: TListBox; const S: String; const AObject: TObject; const LineBreaks: Boolean; const Prefix: TAddLinesPrefix; const PrefixParam: Cardinal);
 var
   ST: TSystemTime;
-  FirstLine: Boolean;
+  LineNumber: Cardinal;
 
   procedure AddLine(S: String);
   var
-    StartsWithTab: Boolean;
+    TimestampPrefixTab: Boolean;
     DC: HDC;
     Size: TSize;
   begin
-    if FirstLine then begin
-      FirstLine := False;
-      { Don't forget about DebugOutputListDrawItem if you change the format of the following timestamp. }
-      Insert(Format('[%.2u%s%.2u%s%.2u%s%.3u]   ', [ST.wHour, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator,
-        ST.wMinute, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator, ST.wSecond, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}DecimalSeparator,
-        ST.wMilliseconds]), S, 1);
-      StartsWithTab := False;
-    end
-    else begin
-      Insert(#9, S, 1);
-      StartsWithTab := True;
+    TimestampPrefixTab := False;
+    case Prefix of
+      alpTimestamp:
+        begin
+          if LineNumber = 0 then begin
+            { Don't forget about ListBox's DrawItem if you change the format of the following timestamp. }
+            Insert(Format('[%.2u%s%.2u%s%.2u%s%.3u]   ', [ST.wHour, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator,
+              ST.wMinute, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator, ST.wSecond, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}DecimalSeparator,
+              ST.wMilliseconds]), S, 1);
+          end else begin
+            Insert(#9, S, 1); { Not actually painted - just for Ctrl+C }
+            TimestampPrefixTab := True;
+          end;
+        end;
+      alpCountdown:
+        begin
+          Insert(Format('[%.2d]   ', [PrefixParam-LineNumber]), S, 1);
+        end;
     end;
     try
-      DebugOutputList.TopIndex := DebugOutputList.Items.Add(S);
+      ListBox.TopIndex := ListBox.Items.AddObject(S, AObject);
     except
       on EOutOfResources do begin
-        DebugOutputList.Clear;
-        SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
-        DebugOutputList.Items.Add(SCompilerStatusReset);
-        DebugOutputList.TopIndex := DebugOutputList.Items.Add(S);
+        ListBox.Clear;
+        SendMessage(ListBox.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
+        ListBox.Items.Add(SCompilerStatusReset);
+        ListBox.TopIndex := ListBox.Items.Add(S);
       end;
     end;
     DC := GetDC(0);
     try
-      SelectObject(DC, DebugOutputList.Font.Handle);
-      if StartsWithTab then
+      SelectObject(DC, ListBox.Font.Handle);
+      if TimestampPrefixTab then
         GetTextExtentPoint(DC, PChar(S)+1, Length(S)-1, Size)
       else
         GetTextExtentPoint(DC, PChar(S), Length(S), Size);
@@ -1528,10 +1518,11 @@ var
       ReleaseDC(0, DC);
     end;
     Inc(Size.cx, 5);
-    if StartsWithTab then
-      Inc(Size.cx, FDebugLogListTimeWidth);
-    if Size.cx > SendMessage(DebugOutputList.Handle, LB_GETHORIZONTALEXTENT, 0, 0) then
-      SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, Size.cx, 0);
+    if TimestampPrefixTab then
+      Inc(Size.cx, PrefixParam);
+    if Size.cx > SendMessage(ListBox.Handle, LB_GETHORIZONTALEXTENT, 0, 0) then
+      SendMessage(ListBox.Handle, LB_SETHORIZONTALEXTENT, Size.cx, 0);
+    Inc(LineNumber);
   end;
 
 var
@@ -1539,29 +1530,51 @@ var
   LastWasCR: Boolean;
 begin
   GetLocalTime(ST);
-  FirstLine := True;
-  LineStart := 1;
-  LastWasCR := False;
-  { Call AddLine for each line. CR, LF, and CRLF line breaks are supported. }
-  for I := 1 to Length(S) do begin
-    if S[I] = #13 then begin
-      AddLine(Copy(S, LineStart, I - LineStart));
-      LineStart := I + 1;
-      LastWasCR := True;
-    end
-    else begin
-      if S[I] = #10 then begin
-        if not LastWasCR then
-          AddLine(Copy(S, LineStart, I - LineStart));
+  if LineBreaks then begin
+    LineNumber := 0;
+    LineStart := 1;
+    LastWasCR := False;
+    { Call AddLine for each line. CR, LF, and CRLF line breaks are supported. }
+    for I := 1 to Length(S) do begin
+      if S[I] = #13 then begin
+        AddLine(Copy(S, LineStart, I - LineStart));
         LineStart := I + 1;
+        LastWasCR := True;
+      end
+      else begin
+        if S[I] = #10 then begin
+          if not LastWasCR then
+            AddLine(Copy(S, LineStart, I - LineStart));
+          LineStart := I + 1;
+        end;
+        LastWasCR := False;
       end;
-      LastWasCR := False;
     end;
-  end;
-  AddLine(Copy(S, LineStart, Maxint));
+    AddLine(Copy(S, LineStart, Maxint));
+  end else
+    AddLine(S);
+end;
+
+procedure TCompileForm.StatusMessage(const Kind: TStatusMessageKind; const S: String);
+begin
+  AddLines(CompilerOutputList, S, TObject(Kind), False, alpNone, 0);
+  CompilerOutputList.Update;
+end;
+
+procedure TCompileForm.DebugLogMessage(const S: String);
+begin
+  AddLines(DebugOutputList, S, nil, True, alpTimestamp, FDebugLogListTimestampsWidth);
   DebugOutputList.Update;
 end;
 
+procedure TCompileForm.DebugShowCallStack(const CallStack: String; const CallStackCount: Cardinal);
+begin
+  DebugCallStackList.Clear;
+  AddLines(DebugCallStackList, CallStack, nil, True, alpCountdown, FCallStackCount-1);
+  DebugCallStackList.Items.Insert(0, '*** [Code] Call Stack');
+  DebugCallStackList.Update;
+end;
+
 type
   PAppData = ^TAppData;
   TAppData = record
@@ -1734,6 +1747,8 @@ begin
     SendMessage(CompilerOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
     DebugOutputList.Clear;
     SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
+    DebugCallStackList.Clear;
+    SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
     TabSet.TabIndex := tiCompilerOutput;
     SetStatusPanelVisible(True);
 
@@ -2050,6 +2065,7 @@ begin
   VHide.Checked := not StatusPanel.Visible;
   VCompilerOutput.Checked := StatusPanel.Visible and (TabSet.TabIndex = tiCompilerOutput);
   VDebugOutput.Checked := StatusPanel.Visible and (TabSet.TabIndex = tiDebugOutput);
+  VDebugCallStack.Checked := StatusPanel.Visible and (TabSet.TabIndex = tiDebugCallStack);
 end;
 
 procedure TCompileForm.VZoomInClick(Sender: TObject);
@@ -2119,6 +2135,12 @@ begin
   SetStatusPanelVisible(True);
 end;
 
+procedure TCompileForm.VDebugCallStackClick(Sender: TObject);
+begin
+  TabSet.TabIndex := tiDebugCallStack;
+  SetStatusPanelVisible(True);
+end;
+
 procedure TCompileForm.BMenuClick(Sender: TObject);
 begin
   BLowPriority.Checked := FOptions.LowPriorityDuringCompile;
@@ -2489,14 +2511,17 @@ begin
   StatusPanel.Height := H;
 end;
 
-procedure TCompileForm.UpdateOutputListsItemHeightAndDebugTimeWidth;
+procedure TCompileForm.UpdateTabSetListsItemHeightAndDebugTimeWidth;
 begin
   CompilerOutputList.Canvas.Font.Assign(CompilerOutputList.Font);
   CompilerOutputList.ItemHeight := CompilerOutputList.Canvas.TextHeight('0');
 
   DebugOutputList.Canvas.Font.Assign(DebugOutputList.Font);
-  FDebugLogListTimeWidth := DebugOutputList.Canvas.TextWidth(Format('[00%s00%s00%s000]   ', [FormatSettings.TimeSeparator, FormatSettings.TimeSeparator, FormatSettings.DecimalSeparator]));
+  FDebugLogListTimestampsWidth := DebugOutputList.Canvas.TextWidth(Format('[00%s00%s00%s000]   ', [FormatSettings.TimeSeparator, FormatSettings.TimeSeparator, FormatSettings.DecimalSeparator]));
   DebugOutputList.ItemHeight := DebugOutputList.Canvas.TextHeight('0');
+
+  DebugCallStackList.Canvas.Font.Assign(DebugCallStackList.Font);
+  DebugCallStackList.ItemHeight := DebugCallStackList.Canvas.TextHeight('0');
 end;
 
 procedure TCompileForm.SplitPanelMouseMove(Sender: TObject;
@@ -3316,6 +3341,11 @@ begin
   SetForegroundWindow(HWND(Message.WParam));
 end;
 
+procedure TCompileForm.WMDebuggerCallStackCount(var Message: TMessage);
+begin
+  FCallStackCount := Message.WParam;
+end;
+
 procedure TCompileForm.WMCopyData(var Message: TWMCopyData);
 var
   S: String;
@@ -3355,6 +3385,11 @@ begin
         FTempDir := S;
         Message.Result := 1;
       end;
+    CD_Debugger_CallStackW: begin
+        SetString(S, PChar(Message.CopyDataStruct.lpData),
+          Message.CopyDataStruct.cbData div SizeOf(Char));
+        DebugShowCallStack(S, FCallStackCount);
+      end;
   end;
 end;
 
@@ -3593,6 +3628,9 @@ begin
   DebugOutputList.Font.Color := FTheme.Colors[tcFore];
   DebugOutputList.Color := FTheme.Colors[tcBack];
   DebugOutputList.Invalidate;
+  DebugCallStackList.Font.Color := FTheme.Colors[tcFore];
+  DebugCallStackList.Color := FTheme.Colors[tcBack];
+  DebugCallStackList.Invalidate;
 end;
 
 procedure TCompileForm.UpdateThemeData(const Close, Open: Boolean);
@@ -3643,7 +3681,10 @@ begin
   ResetLineState;
   DebugOutputList.Clear;
   SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
-  TabSet.TabIndex := tiDebugOutput;
+  DebugCallStackList.Clear;
+  SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
+  if not (TabSet.TabIndex in [tiDebugOutput, tiDebugCallStack]) then
+    TabSet.TabIndex := tiDebugOutput;
   SetStatusPanelVisible(True);
 
   FillChar(Info, SizeOf(Info), 0);
@@ -3729,6 +3770,11 @@ begin
       FPaused := False;
       UpdateRunMenu;
       UpdateCaption;
+      if DebugCallStackList.Items.Count > 0 then begin
+        DebugCallStackList.Clear;
+        SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
+        DebugCallStackList.Update;
+      end;
       { Tell it to continue }
       SendNotifyMessage(FDebugClientWnd, WM_DebugClient_Continue,
         Ord(AStepMode = smStepOver), 0);
@@ -3883,8 +3929,10 @@ var
 begin
   if CompilerOutputList.Visible then
     ListBox := CompilerOutputList
+  else if DebugOutputList.Visible then
+    ListBox := DebugOutputList
   else
-    ListBox := DebugOutputList;
+    ListBox := DebugCallStackList;
   Text := '';
   if ListBox.SelCount > 0 then begin
     for I := 0 to ListBox.Items.Count-1 do begin
@@ -3905,8 +3953,10 @@ var
 begin
   if CompilerOutputList.Visible then
     ListBox := CompilerOutputList
+  else if DebugOutputList.Visible then
+    ListBox := DebugOutputList
   else
-    ListBox := DebugOutputList;
+    ListBox := DebugCallStackList;
   ListBox.Items.BeginUpdate;
   try
     for I := 0 to ListBox.Items.Count-1 do
@@ -4129,18 +4179,32 @@ begin
   Canvas.FillRect(Rect);
   Inc(Rect.Left, 2);
   if (S <> '') and (S[1] = #9) then
-    Canvas.TextOut(Rect.Left + FDebugLogListTimeWidth, Rect.Top, Copy(S, 2, Maxint))
+    Canvas.TextOut(Rect.Left + FDebugLogListTimestampsWidth, Rect.Top, Copy(S, 2, Maxint))
   else begin
     if (Length(S) > 20) and (S[18] = '-') and (S[19] = '-') and (S[20] = ' ') then begin
       { Draw lines that begin with '-- ' (like '-- File entry --') in bold }
       Canvas.TextOut(Rect.Left, Rect.Top, Copy(S, 1, 17));
       Canvas.Font.Style := [fsBold];
-      Canvas.TextOut(Rect.Left + FDebugLogListTimeWidth, Rect.Top, Copy(S, 18, Maxint));
+      Canvas.TextOut(Rect.Left + FDebugLogListTimestampsWidth, Rect.Top, Copy(S, 18, Maxint));
     end else
       Canvas.TextOut(Rect.Left, Rect.Top, S);
   end;
 end;
 
+procedure TCompileForm.DebugCallStackListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
+  State: TOwnerDrawState);
+var
+  Canvas: TCanvas;
+  S: String;
+begin
+  Canvas := DebugCallStackList.Canvas;
+  S := DebugCallStackList.Items[Index];
+
+  Canvas.FillRect(Rect);
+  Inc(Rect.Left, 2);
+  Canvas.TextOut(Rect.Left, Rect.Top, S);
+end;
+
 procedure TCompileForm.TabSetClick(Sender: TObject);
 begin
   case TabSet.TabIndex of
@@ -4149,12 +4213,21 @@ begin
         CompilerOutputList.BringToFront;
         CompilerOutputList.Visible := True;
         DebugOutputList.Visible := False;
+        DebugCallStackList.Visible := False;
       end;
     tiDebugOutput:
       begin
         DebugOutputList.BringToFront;
         DebugOutputList.Visible := True;
         CompilerOutputList.Visible := False;
+        DebugCallStackList.Visible := False;
+      end;
+    tiDebugCallStack:
+      begin
+        DebugCallStackList.BringToFront;
+        DebugCallStackList.Visible := True;
+        CompilerOutputList.Visible := False;
+        DebugOutputList.Visible := False;
       end;
   end;
 end;

Projects/DebugClient.pas

@@ -2,13 +2,11 @@ unit DebugClient;
 
 {
   Inno Setup
-  Copyright (C) 1997-2010 Jordan Russell
+  Copyright (C) 1997-2019 Jordan Russell
   Portions by Martijn Laan
   For conditions of distribution and use, see LICENSE.TXT.
 
   Debug info stuff
-
-  $jrsoftware: issrc/Projects/DebugClient.pas,v 1.29 2010/10/30 19:50:37 jr Exp $
 }
 
 interface
@@ -21,8 +19,11 @@ var
   DebugClientCompiledCodeText: AnsiString;
   DebugClientCompiledCodeDebugInfo: AnsiString;
 
+type
+  TDebugNotifyGetCallStack = function(var CallStackCount: Cardinal): String of object;
+
 function DebugNotify(Kind: TDebugEntryKind; Index: Integer;
-  var ADebugContinueStepOver: Boolean): Boolean;
+  var ADebugContinueStepOver: Boolean; const GetCallStack: TDebugNotifyGetCallStack = nil): Boolean;
 procedure DebugNotifyException(Exception: String; Kind: TDebugEntryKind; Index: Integer);
 function DebugNotifyIntermediate(Kind: TDebugEntryKind; Index: Integer;
   var ADebugContinueStepOver: Boolean): Boolean;
@@ -93,14 +94,16 @@ begin
 end;
 
 function InternalDebugNotify(DebuggerMsg: UINT; Kind: TDebugEntryKind;
-  Index: Integer; var ADebugContinueStepOver: Boolean): Boolean;
+  Index: Integer; var ADebugContinueStepOver: Boolean;
+  const GetCallStack: TDebugNotifyGetCallStack = nil; const GetCallStackData: Pointer = nil): Boolean;
 { Returns True if the debugger paused. ADebugContinueStepOver is set to True
   if the debugger paused and the user resumed via Step Over, False otherwise. }
 var
-  SaveAppTitle: String;
+  SaveAppTitle, CallStack: String;
   WindowList: Pointer;
   Msg: TMsg;
   TopWindow: HWND;
+  CallStackCount: Cardinal;
 begin
   Result := False;
   ADebugContinueStepOver := False;
@@ -113,6 +116,13 @@ begin
     { Don't pause }
     Exit;
   end;
+
+  if Assigned(GetCallStack) then begin
+    CallStack := GetCallStack(CallStackCount);
+    SendMessage(DebugWnd, WM_Debugger_CallStackCount, CallStackCount, 0);
+    SendCopyDataMessageStr(DebugWnd, DebugClientWnd, CD_Debugger_CallStackW, CallStack);
+  end;
+
   Result := True;
 
   { Wait until we get clearance to continue }
@@ -157,17 +167,18 @@ begin
 end;
 
 function DebugNotify(Kind: TDebugEntryKind; Index: Integer;
-  var ADebugContinueStepOver: Boolean): Boolean;
+  var ADebugContinueStepOver: Boolean;
+  const GetCallStack: TDebugNotifyGetCallStack = nil): Boolean;
 begin
   Result := InternalDebugNotify(WM_Debugger_Stepped, Kind, Index,
-    ADebugContinueStepOver);
+    ADebugContinueStepOver, GetCallStack);
 end;
 
 function DebugNotifyIntermediate(Kind: TDebugEntryKind; Index: Integer;
   var ADebugContinueStepOver: Boolean): Boolean;
 begin
   Result := InternalDebugNotify(WM_Debugger_SteppedIntermediate, Kind, Index,
-    ADebugContinueStepOver);
+    ADebugContinueStepOver, nil);
 end;
 
 procedure DebugNotifyException(Exception: String; Kind: TDebugEntryKind; Index: Integer);

Projects/DebugStruct.pas

@@ -23,12 +23,14 @@ const
   WM_Debugger_Exception = WM_USER + $704;
   WM_Debugger_SetForegroundWindow = WM_USER + $705;
   WM_Debugger_QueryVersion = WM_USER + $706;
+  WM_Debugger_CallStackCount = WM_USER + $707;
   { Debug client -> debugger WM_COPYDATA messages }
   CD_Debugger_ReplyW = $700;
   CD_Debugger_ExceptionW = $701;
   CD_Debugger_UninstExeW = $702;
   CD_Debugger_LogMessageW = $703;
   CD_Debugger_TempDirW = $704;
+  CD_Debugger_CallStackW = $705;
 
   { Debugger -> debug client messages }
   WM_DebugClient_Detach = WM_USER + $800;

Projects/Main.pas

@@ -2119,7 +2119,7 @@ end;
 function CodeRunnerOnDebug(const Position: LongInt;
   var ContinueStepOver: Boolean): Boolean;
 begin
-  Result := DebugNotify(deCodeLine, Position, ContinueStepOver);
+  Result := DebugNotify(deCodeLine, Position, ContinueStepOver, CodeRunner.GetCallStack);
 end;
 
 function CodeRunnerOnDebugIntermediate(const Position: LongInt;

Projects/ScriptRunner.pas

@@ -59,6 +59,7 @@ type
       function RunStringFunction(const Name: AnsiString; const Parameters: array of Const; const MustExist: Boolean; const Default: String): String;
       function RunStringFunctions(const Name: AnsiString; const Parameters: array of Const; const BreakCondition: TBreakCondition; const MustExist: Boolean; Default: String): String;
       function EvaluateUsedVariable(const Param1, Param2, Param3: LongInt; const Param4: AnsiString): String;
+      function GetCallStack(var CallStackCount: Cardinal): String;
       property NamingAttribute: String write FNamingAttribute;
       property OnLog: TScriptRunnerOnLog read FOnLog write FOnLog;
       property OnLogFmt: TScriptRunnerOnLogFmt read FOnLogFmt write FOnLogFmt;
@@ -676,5 +677,10 @@ begin
   end;
 end;
 
+function TScriptRunner.GetCallStack(var CallStackCount: Cardinal): String;
+begin
+  Result := FPSExec.GetCallStack(CallStackCount);
+end;
+
 end.
 

whatsnew.htm

@@ -31,7 +31,12 @@ For conditions of distribution and use, see <a href="http://www.jrsoftware.org/f
   <li>/LOG: Now logs Windows compatibility mode when this is activated by the user.</li>
   <li>Added new [Setup] section directive: <tt>SignToolRunMinimized</tt>.</li>
   <li>Checkboxes displayed by lists now look better on high DPI systems.</li>
-  <li>Compiler IDE change: The "Compiler Output" and "Debug Output" views now support multi selection, an extra <i>Select All</i> popup menu item and <i>Ctrl+C</i> and </i>Ctrl+A</i> keyboard shortcuts. The <i>Copy</i> action now only copies the selected lines instead of all lines.</li>
+  <li>Compiler IDE changes:
+  <ul>
+    <li>The "Compiler Output" and "Debug Output" views now support multi selection, an extra <i>Select All</i> popup menu item and <i>Ctrl+C</i> and </i>Ctrl+A</i> keyboard shortcuts. The <i>Copy</i> action now only copies the selected lines instead of all lines.</li>
+    <li>When paused on a breakpoint in the [Code] section the new "Debug Call Stack" view now shows the call stack.</li>
+  </ul>
+  </li>
   <li>Inno Setup Preprocessor (ISPP) change: Added new predefined variable <tt>Tab</tt>.</li>
   <li>Pascal Scripting change: Added new <tt>Set8087CW</tt> and <tt>Get8087CW</tt> support functions.</li>
   <li>Some messages have been added in this version: (<a href="https://github.com/jrsoftware/issrc/commit/dfdf02aef168be458b64e77afb20ae53a5b4f2ec">View differences in Default.isl</a>).
@@ -44,6 +49,8 @@ For conditions of distribution and use, see <a href="http://www.jrsoftware.org/f
   <li>Minor tweaks.</li>
 </ul>
 
+<p>Contributions via <a href="https://github.com/jrsoftware/issrc" target="_blank">GitHub</a>: Thanks to Vizit0r for their contributions.</p>
+
 <p><a name="6.0.2"></a><span class="ver">6.0.2 </span><span class="date">(2019-04-26)</span></p>
 <ul>
   <li>Added new <tt>{sysnative}</tt> constant.</li>