gdb commander, allow to evaluate the editor expression when mouse motion stops

this does not work very well because of the missing dereference (*) when required
so use of temporaries during debug might be advisable.

src/u_dbgitf.pas

@@ -23,9 +23,10 @@ type
     procedure addBreakPoint(const fname: string; line: integer; kind: TBreakPointKind = bpkBreak);
     procedure removeBreakPoint(const fname: string; line: integer; kind: TBreakPointKind = bpkBreak);
     procedure removeBreakPoints(const fname: string);
+    function evaluate(const exp: string): string;
   end;
 
-  // Enumerates th e reason why debuging breaks.
+  // Enumerates the reason why debuging breaks.
   TDebugBreakReason = (
     dbUnknown,      // ?
     dbBreakPoint,   // a break point is reached.

src/u_dlang.pas

@@ -153,6 +153,12 @@ procedure getImports(list: TLexTokenList; imports: TStrings);
  *)
 function getIndexOfTokenLeftTo(tokens: TLexTokenList; caretPos: TPoint): integer;
 
+(**
+ * Get the expression, as a string, that ends at the caret position.
+ * This helper is mostly used by GDB commander
+ *)
+function getExpressionAt(tokens: TLexTokenList; caretPos: TPoint): string;
+
 implementation
 
 {$REGION TReaderHead -----------------------------------------------------------}
@@ -1026,6 +1032,55 @@ begin
   end;
 end;
 
+function getExpressionAt(tokens: TLexTokenList; caretPos: TPoint): string;
+var
+  ri: integer;
+  li: integer = -1;
+  p : integer = 1;
+  i : integer;
+  t : PLexToken;
+begin
+  result := '';
+  ri := getIndexOfTokenLeftTo(tokens, caretPos);
+  if ri <> -1 then
+    for i := ri downto 0 do
+  begin
+    t := tokens[i];
+    //  other; a.b.c|.d  ->  a.b.c
+    if (t^.kind = TLexTokenKind.ltkSymbol) and
+       ((t^.Data = ';') or (t^.Data = ',') or (t^.Data = '{') or (t^.Data = ':') or (t^.Data = '?')) then
+    begin
+      li := i+1;
+      break;
+    end
+    //  other; a.b c|.d  ->  c
+    else if (t^.kind = TLexTokenKind.ltkWhite) then
+    begin
+      li := i+1;
+      break;
+    end
+    //  other; a + b.c|.d  ->  b.c
+    else if (t^.kind = TLexTokenKind.ltkOperator) then
+    begin
+      li := i+1;
+      break;
+    end;
+    p += Byte((t^.kind = TLexTokenKind.ltkSymbol) and (t^.Data = ')'));
+    p -= Byte((t^.kind = TLexTokenKind.ltkSymbol) and (t^.Data = '('));
+    //  (a.(b).c|.d)  ->  a.(b).c
+    if p = 0 then
+    begin
+      li := i+1;
+      break;
+    end;
+  end;
+  if (li <> -1) and (li <> -1) then
+  begin
+    for i := li to ri do
+      result += tokens[i]^.Data;
+  end;
+end;
+
 function TLexErrorList.getError(index: integer): TLexError;
 begin
   Result := PLexError(Items[index])^;

src/u_gdb.lfm

@@ -36,8 +36,8 @@ inherited GdbWidget: TGdbWidget
           Width = 672
           Align = alClient
           Caption = 'CPU'
-          ClientHeight = 156
-          ClientWidth = 670
+          ClientHeight = 155
+          ClientWidth = 668
           TabOrder = 0
           object cpuViewer: TTIPropertyGrid
             Left = 0
@@ -77,8 +77,8 @@ inherited GdbWidget: TGdbWidget
           OnChange = PageControl2Change
           object TabSheet3: TTabSheet
             Caption = 'Variables'
-            ClientHeight = 169
-            ClientWidth = 662
+            ClientHeight = 173
+            ClientWidth = 670
             object lstVariables: TListView
               Left = 2
               Height = 130
@@ -124,8 +124,8 @@ inherited GdbWidget: TGdbWidget
           end
           object TabSheet4: TTabSheet
             Caption = 'Assembler'
-            ClientHeight = 169
-            ClientWidth = 662
+            ClientHeight = 173
+            ClientWidth = 670
             object lstAsm: TListView
               Left = 2
               Height = 161
@@ -214,8 +214,8 @@ inherited GdbWidget: TGdbWidget
         TabOrder = 3
         object TabSheet1: TTabSheet
           Caption = 'Call stack'
-          ClientHeight = 169
-          ClientWidth = 662
+          ClientHeight = 173
+          ClientWidth = 670
           object lstCallStack: TListView
             Left = 0
             Height = 169
@@ -251,8 +251,8 @@ inherited GdbWidget: TGdbWidget
         end
         object TabSheet2: TTabSheet
           Caption = 'Thread list'
-          ClientHeight = 169
-          ClientWidth = 662
+          ClientHeight = 173
+          ClientWidth = 670
           object lstThreads: TListView
             Left = 0
             Height = 169
@@ -307,8 +307,8 @@ inherited GdbWidget: TGdbWidget
         end
         object TabSheet5: TTabSheet
           Caption = 'Debugee options'
-          ClientHeight = 169
-          ClientWidth = 662
+          ClientHeight = 173
+          ClientWidth = 670
           object dbgeeOptsEd: TTIPropertyGrid
             Left = 2
             Height = 161
@@ -330,6 +330,7 @@ inherited GdbWidget: TGdbWidget
       end
     end
     inherited toolbar: TDexedToolBar
+      Height = 30
       Width = 664
       object btnStack: TDexedToolButton[0]
         Left = 238
@@ -353,7 +354,7 @@ inherited GdbWidget: TGdbWidget
       end
       object button4: TDexedToolButton[2]
         Left = 205
-        Height = 28
+        Height = 5
         Top = 0
         AutoSize = True
         Caption = 'button4'

src/u_gdb.pas

@@ -502,6 +502,8 @@ type
     fDoc: TDexedMemo;
     fDbgRunnable: boolean;
     fCatchCustomEval: boolean;
+    fCatchCustomEvalAsString: boolean;
+    fCaughtCustomEvalAstring: string;
     fProj: ICommonProject;
     fJson: TJsonObject;
     fLog: TStringList;
@@ -576,6 +578,7 @@ type
     procedure removeBreakPoint(const fname: string; line: integer;
       kind: TBreakPointKind = bpkBreak);
     procedure removeBreakPoints(const fname: string);
+    function evaluate(const exp: string): string;
     procedure executeFromShortcut(sender: TObject);
   public
     constructor create(aOwner: TComponent); override;
@@ -1686,6 +1689,20 @@ begin
   updateButtonsState;
 end;
 
+function TGdbWidget.evaluate(const exp: string): string;
+begin
+  result := '';
+  if fGdbState <> gsPaused then
+    exit;
+  fCatchCustomEvalAsString:=true;
+  fCaughtCustomEvalAstring := '';
+  gdbCommand('-data-evaluate-expression "' + exp + '"', @gdboutJsonize);
+  sleep(25);
+  Application.ProcessMessages();
+  sleep(25);
+  result := fCaughtCustomEvalAstring;
+end;
+
 procedure TGdbWidget.updateButtonsState;
 begin
   case fGdbState of
@@ -2256,6 +2273,15 @@ begin
     exit;
   end;
 
+  if fCatchCustomEvalAsString then
+  begin
+    fCatchCustomEvalAsString := false;
+    fCaughtCustomEvalAstring := '';
+    if fJson.findAny('value', val) then
+      fCaughtCustomEvalAstring := val.AsString;
+    exit;
+  end;
+
   if fJson.findAny('reason', val) then
   begin
     reason := val.AsString;

src/u_synmemo.pas

@@ -2773,12 +2773,28 @@ end;
 
 procedure TDexedMemo.showDDocs;
 var
+  exp: string;
+  ev1: string;
+  ev2: string;
   str: string;
 begin
   fCanShowHint := false;
   if not fIsDSource and not alwaysAdvancedFeatures then
     exit;
-  DcdWrapper.getDdocFromCursor(str);
+
+  if assigned(fDebugger) and fDebugger.running then
+  begin
+    lexWholeText([TLexOption.lxoNoComments]);
+    exp := getExpressionAt(fLexToks, fMousePos);
+    ev1 := fDebugger.evaluate(exp);
+    if ev1.isEmpty then
+      ev1 := '???';
+    ev2 := fDebugger.evaluate('*' + exp);
+    if ev2.isEmpty then
+      ev2 := '???';
+    str := format('exp: %s'#10'---'#10'%s'#10'---'#10'%s', [exp, ev1, ev2]);
+  end
+  else DcdWrapper.getDdocFromCursor(str);
 
   if str.isNotEmpty then
   begin