diff --git a/src/ce_gdb.lfm b/src/ce_gdb.lfm index 8c575409..4ebebe31 100644 --- a/src/ce_gdb.lfm +++ b/src/ce_gdb.lfm @@ -58,7 +58,7 @@ inherited CEGdbWidget: TCEGdbWidget Cursor = crVSplit Left = 0 Height = 6 - Top = 0 + Top = 200 Width = 517 Align = alTop ResizeAnchor = akTop @@ -66,7 +66,7 @@ inherited CEGdbWidget: TCEGdbWidget object PageControl2: TPageControl Left = 0 Height = 200 - Top = 6 + Top = 0 Width = 517 ActivePage = TabSheet3 Align = alTop @@ -200,6 +200,7 @@ inherited CEGdbWidget: TCEGdbWidget object PageControl1: TPageControl[3] Left = 0 Height = 200 + Hint = 'edit the command line and the environment of the debuger target' Top = 0 Width = 517 ActivePage = TabSheet1 @@ -298,6 +299,27 @@ inherited CEGdbWidget: TCEGdbWidget OnDblClick = lstThreadsDblClick end end + object TabSheet5: TTabSheet + Caption = 'Debugee options' + ClientHeight = 164 + ClientWidth = 509 + object dbgeeOptsEd: TTIPropertyGrid + Left = 2 + Height = 160 + Top = 2 + Width = 505 + Align = alClient + BorderSpacing.Around = 2 + CheckboxForBoolean = True + DefaultValueFont.Color = clWindowText + Filter = [tkInteger, tkChar, tkEnumeration, tkFloat, tkSet, tkMethod, tkSString, tkLString, tkAString, tkWString, tkVariant, tkArray, tkRecord, tkInterface, tkClass, tkObject, tkWChar, tkBool, tkInt64, tkQWord, tkDynArray, tkInterfaceRaw, tkProcVar, tkUString, tkUChar, tkHelper, tkFile, tkClassRef, tkPointer] + Indent = 10 + NameFont.Color = clWindowText + PreferredSplitterX = 190 + SplitterX = 190 + ValueFont.Color = clGreen + end + end end end inherited toolbar: TCEToolBar diff --git a/src/ce_gdb.pas b/src/ce_gdb.pas index e257f126..2499d1f6 100644 --- a/src/ce_gdb.pas +++ b/src/ce_gdb.pas @@ -324,6 +324,46 @@ type TAddWatchPointKind = (wpkRead, wpkWrite, wpkReadWrite); + // Persistent command line & environment of the inferior. + TCEDebugeeOption = class(TCollectionItem) + strict private + fQueryArguments: boolean; + fFname: string; + fWorkingDir: TCEPathname; + fAgruments: TStringList; + fEnvPaths: TStringList; + procedure setOptions(value: TStringList); + procedure setEnvPaths(value: TStringList); + published + property environmentPaths: TStringList read fEnvPaths write fEnvPaths; + property filename: string read fFname write fFname; + property arguments: TStringList read fAgruments write setOptions; + property queryArguments: boolean read fQueryArguments write fQueryArguments default false; + property workingDirectory: TCEPathname read fWorkingDir write fWorkingDir; + public + constructor Create(ACollection: TCollection); override; + destructor Destroy; override; + end; + + // Store for the command line & environment of the inferior. + TCEDebugeeOptions = class(TWritableLfmTextComponent) + strict private + fProjects: TCollection; + procedure setProjects(value: TCollection); + function getProjectByIndex(index: integer): TCEDebugeeOption; + function getProjectByFile(const fname: string): TCEDebugeeOption; + procedure cleanup; + protected + procedure beforeSave; override; + published + property projects: TCollection read fProjects write setProjects; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + property projectByIndex[index: integer]: TCEDebugeeOption read getProjectByIndex; + property projectByFile[const fname: string]: TCEDebugeeOption read getProjectByFile; default; + end; + { TCEGdbWidget } TCEGdbWidget = class(TCEWidget, ICEProjectObserver, ICEDocumentObserver, ICEDebugger) btnContinue: TCEToolButton; @@ -367,6 +407,8 @@ type Splitter3: TSplitter; Splitter4: TSplitter; lstAsm: TListView; + TabSheet5: TTabSheet; + dbgeeOptsEd: TTIPropertyGrid; varListFlt: TListViewFilterEdit; procedure btnContClick(Sender: TObject); procedure btnVariablesClick(Sender: TObject); @@ -422,6 +464,7 @@ type fLastOffset: string; fLastLine: string; fCommandProcessed: boolean; + fDebugeeOptions: TCEDebugeeOptions; procedure waitCommandProcessed; procedure clearDisplays; procedure updateMenu; @@ -432,6 +475,7 @@ type procedure startDebugging; procedure killGdb; procedure storeObserversBreakpoints; + procedure updateDebugeeOptionsEditor; // GDB output processors procedure gdboutQuiet(sender: TObject); procedure gdboutJsonize(sender: TObject); @@ -516,11 +560,11 @@ type implementation {$R *.lfm} -{$REGION TCEDebugOption --------------------------------------------------------} const optFname = 'gdbcommander.txt'; const bpFname = 'breakpoints.txt'; +const prjFname = 'projectsgdboptions.txt'; - +{$REGION TCEDebugOption --------------------------------------------------------} procedure TCEDebugShortcuts.assign(source: TPersistent); var src: TCEDebugShortcuts; @@ -967,6 +1011,96 @@ begin end; {$ENDREGION} +{$REGION TCEDebugeeOption ------------------------------------------------------} +constructor TCEDebugeeOption.Create(ACollection: TCollection); +begin + inherited create(ACollection); + fAgruments := TStringList.Create; + fEnvPaths := TStringList.Create; + fAgruments.Delimiter:= ' '; +end; + +destructor TCEDebugeeOption.Destroy; +begin + fAgruments.Free; + fEnvPaths.Free; + inherited; +end; + +procedure TCEDebugeeOption.setOptions(value: TStringList); +begin + fAgruments.Assign(value); +end; + +procedure TCEDebugeeOption.setEnvPaths(value: TStringList); +begin + fEnvPaths.Assign(value); +end; + +constructor TCEDebugeeOptions.Create(AOwner: TComponent); +var + fname: string; +begin + inherited create(AOwner); + fProjects := TCollection.Create(TCEDebugeeOption); + fname := getCoeditDocPath + prjFname; + if fname.fileExists then + loadFromFile(fname); +end; + +destructor TCEDebugeeOptions.Destroy; +begin + saveToFile(getCoeditDocPath + prjFname); + fProjects.Free; + inherited; +end; + +procedure TCEDebugeeOptions.cleanup; +var + i: integer; + p: TCEDebugeeOption; +begin + for i:= fProjects.Count-1 downto 0 do + begin + p := projectByIndex[i]; + if not p.filename.fileExists or p.filename.isEmpty then + fProjects.Delete(i); + if (p.arguments.Count = 0) and (p.environmentPaths.Count = 0) and + (p.workingDirectory = '') and (p.queryArguments = false) then + fProjects.Delete(i); + end; +end; + +procedure TCEDebugeeOptions.beforeSave; +begin + cleanup; +end; + +procedure TCEDebugeeOptions.setProjects(value: TCollection); +begin + fProjects.Assign(value); +end; + +function TCEDebugeeOptions.getProjectByIndex(index: integer): TCEDebugeeOption; +begin + exit(TCEDebugeeOption(fProjects.Items[index])); +end; + +function TCEDebugeeOptions.getProjectByFile(const fname: string): TCEDebugeeOption; +var + i: integer; +begin + for i := 0 to fProjects.Count-1 do + begin + result := projectByIndex[i]; + if result.filename = fname then + exit; + end; + result := TCEDebugeeOption(fProjects.Add); + result.filename:=fname; +end; +{$ENDREGION} + {$REGION Common/standard comp --------------------------------------------------} constructor TCEGdbWidget.create(aOwner: TComponent); begin @@ -983,6 +1117,7 @@ begin fSubj:= TCEDebugObserverSubject.Create; fOptions:= TCEDebugOptions.create(self); fOptions.onChangesApplied:=@optionsChangesApplied; + fDebugeeOptions:= TCEDebugeeOptions.Create(self); Edit1.Items.Assign(fOptions.commandsHistory); fAddWatchPointKind := wpkWrite; fBreakPoints := TPersistentBreakPoints.create(self); @@ -1190,6 +1325,7 @@ begin if fProj <> project then exit; fProj := nil; + updateDebugeeOptionsEditor; if not fDbgRunnable then begin if fOutputName.fileExists then @@ -1202,6 +1338,7 @@ end; procedure TCEGdbWidget.projFocused(project: ICECommonProject); begin fProj := project; + updateDebugeeOptionsEditor; end; procedure TCEGdbWidget.projCompiling(project: ICECommonProject); @@ -1221,6 +1358,7 @@ end; procedure TCEGdbWidget.docFocused(document: TCESynMemo); begin fDoc := document; + updateDebugeeOptionsEditor; end; procedure TCEGdbWidget.docChanged(document: TCESynMemo); @@ -1232,6 +1370,7 @@ begin if fDoc <> document then exit; fDoc := nil; + updateDebugeeOptionsEditor; if fDbgRunnable then begin if fOutputName.fileExists then @@ -1407,12 +1546,14 @@ procedure TCEGdbWidget.mnuSelProjClick(Sender: TObject); begin fDbgRunnable := false; mnuSelRunnable.Checked:=false; + updateDebugeeOptionsEditor; end; procedure TCEGdbWidget.mnuSelRunnableClick(Sender: TObject); begin fDbgRunnable := true; mnuSelProj.Checked:=false; + updateDebugeeOptionsEditor; end; procedure TCEGdbWidget.mnuWriteWClick(Sender: TObject); @@ -1454,6 +1595,7 @@ var gdb: string; i: integer; b: TPersistentBreakPoint; + o: TCEDebugeeOption; const asmFlavorStr: array[TAsmSyntax] of string = ('intel','att'); begin @@ -1506,16 +1648,16 @@ begin deletefile(fInputName); fInput:= TFileStream.Create(fInputName, fmCreate or fmShareExclusive); subjDebugStart(fSubj, self as ICEDebugger); + case fDbgRunnable of + true: o := fDebugeeOptions.projectByFile[fDoc.fileName]; + false:o := fDebugeeOptions.projectByFile[fProj.fileName]; + end; // gdb process killGdb; fGdb := TCEProcess.create(nil); fGdb.Executable:= gdb; fgdb.Options:= [poUsePipes, poStderrToOutPut]; fgdb.Parameters.Add(fExe); - - //TODO-cGDB: debugee environment - //TODO-cGDB: debugee command line - fgdb.Parameters.Add('--interpreter=mi'); fGdb.OnReadData:= @gdboutQuiet; fGdb.OnTerminate:= @gdboutJsonize; @@ -1557,14 +1699,62 @@ begin else gdbCommand('-gdb-set non-stop off'); fGdb.OnReadData := @gdboutJsonize; - // launch cpuViewer.TIObject := fInspState; cpuViewer.RefreshPropertyValues; - gdbCommand('set args >' + fOutputName + '< ' + fInputName); + // inferior options + if o.environmentPaths.Count <> 0 then + begin + str := ''; + for i:= 0 to o.environmentPaths.Count-1 do + str += o.environmentPaths[i] + ' '; + str := fSyms.expand(str[1..str.length-1]); + gdbCommand('-environment-path ' + str); + end; + if DirectoryExists(o.workingDirectory) then + gdbCommand('-environment-cd ' + fSyms.expand(o.workingDirectory)); + if (o.arguments.Count <> 0) or (o.queryArguments) then + begin + str := ''; + if o.queryArguments and not InputQuery('Command line arguments', 'GDB commander', str) then + str := '' + else + str += ' '; + for i := 0 to o.arguments.Count-1 do + str += o.arguments[i] + ' '; + str := fSyms.expand(str); + end; + gdbCommand('set args '+ str + '> ' + fOutputName + '< ' + fInputName); // non-MI command "run" has the same problem as https://sourceware.org/bugzilla/show_bug.cgi?id=18077 gdbCommand('-exec-run'); setState(gsRunning); end; + +procedure TCEGdbWidget.updateDebugeeOptionsEditor; +var + nme: string = ''; + opt: TCEDebugeeOption; +begin + dbgeeOptsEd.ItemIndex:=-1; + dbgeeOptsEd.TIObject := nil; + if not fDbgRunnable then + begin + if fProj = nil then + exit + else nme := fProj.filename; + if not nme.fileExists then + exit; + end + else + begin + if fDoc = nil then + exit + else nme := fDoc.filename; + if not nme.fileExists then + exit; + end; + opt := fDebugeeOptions.projectByFile[nme]; + dbgeeOptsEd.TIObject := opt; +end; {$ENDREGION} {$REGION GDB output processors -------------------------------------------------}