diff --git a/src/u_dbgitf.pas b/src/u_dbgitf.pas index c9eea1fb..23d9e4cd 100644 --- a/src/u_dbgitf.pas +++ b/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. diff --git a/src/u_dlang.pas b/src/u_dlang.pas index 957cd5bc..9005308f 100644 --- a/src/u_dlang.pas +++ b/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])^; diff --git a/src/u_gdb.lfm b/src/u_gdb.lfm index c8804dad..ca93b54c 100644 --- a/src/u_gdb.lfm +++ b/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' diff --git a/src/u_gdb.pas b/src/u_gdb.pas index eaa56a91..1d67be4e 100644 --- a/src/u_gdb.pas +++ b/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; diff --git a/src/u_synmemo.pas b/src/u_synmemo.pas index d266a3f8..52035742 100644 --- a/src/u_synmemo.pas +++ b/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