paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-29 16:31:40 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: implemented run param environment variables

Browse Source 
git-svn-id: trunk@2750 -
This commit is contained in:
lazarus 2002-08-18 08:53:30 +00:00
parent 45f1d6dc8d
commit 7f4da47cd5
6 changed files with 91 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
debugger/cmdlinedebugger.pp
View File

@ -173,6 +173,7 @@ begin
FDbgProcess.CommandLine := ExternalDebugger + ' ' + AOptions;
FDbgProcess.Options:= [poUsePipes, poNoConsole, poStdErrToOutPut];
FDbgProcess.ShowWindow := swoNone;
//FDbgProcess.Environment:=Environment;
end;
if not FDbgProcess.Running
then begin
@ -361,6 +362,9 @@ end;
end.
{ =============================================================================
$Log$
Revision 1.12 2002/08/28 10:44:44 lazarus
MG: implemented run param environment variables
Revision 1.11 2002/05/10 06:57:47 lazarus
MG: updated licenses

13
debugger/debugger.pp
View File

@ -348,6 +348,7 @@ type
FArguments: String;
FBreakPoints: TDBGBreakPoints;
FBreakPointGroups: TDBGBreakPointGroups;
FEnvironment: TStrings;
FExitCode: Integer;
FExternalDebugger: String;
FFileName: String;
@ -362,6 +363,7 @@ type
FOnState: TNotifyEvent;
function GetState: TDBGState;
function ReqCmd(const ACommand: TDBGCommand; const AParams: array of const): Boolean;
procedure SetEnvironment(const AValue: TStrings);
procedure SetFileName(const AValue: String);
protected
function CreateBreakPoints: TDBGBreakPoints; virtual;
@ -403,6 +405,7 @@ type
property BreakPointGroups: TDBGBreakPointGroups read FBreakPointGroups; // list of all breakpointgroups
property Commands: TDBGCommands read GetCommands; // All current available commands of the debugger
property CallStack: TDBGCallStack read FCallStack;
property Environment: TStrings read FEnvironment write SetEnvironment;
property ExitCode: Integer read FExitCode;
property ExternalDebugger: String read FExternalDebugger;
property FileName: String read FFileName write SetFileName; // The name of the exe to be debugged
@ -457,6 +460,7 @@ begin
FWatches := CreateWatches;
FBreakPointGroups := TDBGBreakPointGroups.Create;
FExitCode := 0;
FEnvironment:=TStringList.Create;
end;
function TDebugger.CreateBreakPoints: TDBGBreakPoints;
@ -500,6 +504,7 @@ begin
FreeAndNil(FLocals);
FreeAndNil(FCallStack);
FreeAndNil(FWatches);
FreeAndNil(FEnvironment);
inherited;
end;
@ -583,6 +588,11 @@ begin
else Result := False;
end;
procedure TDebugger.SetEnvironment(const AValue: TStrings);
begin
FEnvironment.Assign(AValue);
end;
procedure TDebugger.Run;
begin
ReqCmd(dcRun, []);
@ -1461,6 +1471,9 @@ end;
end.
{ =============================================================================
$Log$
Revision 1.16 2002/08/28 10:44:44 lazarus
MG: implemented run param environment variables
Revision 1.15 2002/05/10 06:57:47 lazarus
MG: updated licenses

1
ide/debugmanager.pas
View File

@ -463,6 +463,7 @@ begin
FDebugger.FileName := LaunchingApplication;
FDebugger.Arguments := LaunchingParams;
Project1.RunParameterOptions.AssignEnvironmentTo(FDebugger.Environment);
if FDialogs[ddtOutput] <> nil
then TDbgOutputForm(FDialogs[ddtOutput]).Clear;

6
ide/main.pp
View File

@ -4636,7 +4636,8 @@ begin
WorkingDir:=ExtractFilePath(GetProjectTargetFilename);
MacroList.SubstituteStr(WorkingDir);
FRunProcess.CurrentDirectory:=ExpandFilename(WorkingDir);
Project1.RunParameterOptions.AssignEnvironmentTo(FRunProcess.Environment);
FRunProcess.Options:= [poNoConsole];
FRunProcess.ShowWindow := swoNone;
except
@ -6702,6 +6703,9 @@ end.
{ =============================================================================
$Log$
Revision 1.355 2002/08/28 10:44:43 lazarus
MG: implemented run param environment variables
Revision 1.354 2002/08/27 09:22:44 lazarus
MG: not existing files will now be removed from recent lists

97
ide/runparamsopts.pas
View File

@ -80,6 +80,7 @@ type
procedure Clear;
function Load(XMLConfig: TXMLConfig; const Path: string): TModalResult;
function Save(XMLConfig: TXMLConfig; const Path: string): TModalResult;
procedure AssignEnvironmentTo(Strings: TStrings);
// local options
property HostApplicationFilename: string
@ -146,6 +147,7 @@ type
procedure ResizeLocalPage;
procedure ResizeEnvironmentPage;
procedure SetOptions(NewOptions: TRunParamsOptions);
procedure FillListView(ListView: TListView; sl: TStringList);
procedure FillSystemVariablesListView;
procedure FillUserOverridesListView;
procedure SaveToOptions;
@ -182,7 +184,22 @@ begin
end;
end;
function EnvironmentAsStringList: TStringList;
var
i, SysVarCount, e: integer;
Variable, Value: string;
Begin
Result:=TStringList.Create;
SysVarCount:=EnvCount;
for i:=0 to SysVarCount-1 do begin
Variable:=EnvStr(i+1);
e:=1;
while (e<=length(Variable)) and (Variable[e]<>'=') do inc(e);
Value:=copy(Variable,e+1,length(Variable)-e);
Variable:=LeftStr(Variable,e-1);
Result.Values[Variable]:=Value;
end;
end;
{ TRunParamsOptions }
@ -303,6 +320,27 @@ begin
Result:=mrOk;
end;
procedure TRunParamsOptions.AssignEnvironmentTo(Strings: TStrings);
var
EnvList: TStringList;
i: integer;
Variable, Value: string;
begin
// get system environment
EnvList:=EnvironmentAsStringList;
try
// merge user overrides
for i:=0 to UserOverrides.Count-1 do begin
Variable:=UserOverrides.Names[i];
Value:=UserOverrides.Values[Variable];
EnvList.Values[Variable]:=Value;
end;
Strings.Assign(EnvList);
finally
EnvList.Free;
end;
end;
{ TRunParamsOptsDlg }
@ -604,6 +642,7 @@ begin
SetBounds(5,UserOverridesGroupBox.Top+UserOverridesGroupBox.Height+10,w,25);
Caption:='Include system variables';
Checked:=false;
Enabled:=false;
Visible:=true;
end;
end;
@ -814,7 +853,7 @@ begin
if ShowSysVarUserOverrideDialog(Variable,Value)=mrOk then begin
NewLI:=UserOverridesListView.Items.Add;
NewLI.Caption:=Variable;
NewLI.SubItems[0]:=Value;
NewLI.SubItems.Add(Value);
UserOverridesListView.Selected:=NewLI;
end;
end;
@ -910,44 +949,16 @@ begin
IncludeSystemVariablesCheckBox.Checked:=fOptions.IncludeSystemVariables;
end;
procedure TRunParamsOptsDlg.FillSystemVariablesListView;
var
i, SysVarCount, e: integer;
Variable, Value: string;
Begin
with SystemVariablesListView.Items do begin
//BeginUpdate;
SysVarCount:=EnvCount;
for i:=0 to SysVarCount-1 do begin
Variable:=EnvStr(i+1);
e:=1;
while (e<=length(Variable)) and (Variable[e]<>'=') do inc(e);
Value:=copy(Variable,e+1,length(Variable)-e);
Variable:=LeftStr(Variable,e-1);
if Count<=i then begin
// add line to listview
Add;
Item[i].SubItems.Add('');
end;
Item[i].Caption:=Variable;
Item[i].SubItems[0]:=Value;
end;
while Count>EnvCount do
Delete(Count-1);
//EndUpdate;
end;
end;
procedure TRunParamsOptsDlg.FillUserOverridesListView;
procedure TRunParamsOptsDlg.FillListView(ListView: TListView; sl: TStringList);
var
i: integer;
Variable, Value: string;
Begin
with UserOverridesListView.Items do begin
with ListView.Items do begin
//BeginUpdate;
for i:=0 to Options.UserOverrides.Count-1 do begin
Variable:=Options.UserOverrides.Names[i];
Value:=Options.UserOverrides.Values[Variable];
for i:=0 to sl.Count-1 do begin
Variable:=sl.Names[i];
Value:=sl.Values[Variable];
if Count<=i then begin
// add line to listview
Add;
@ -956,11 +967,25 @@ Begin
Item[i].Caption:=Variable;
Item[i].SubItems[0]:=Value;
end;
while Count>Options.UserOverrides.Count do
while Count>sl.Count do
Delete(Count-1);
//EndUpdate;
end;
end;
procedure TRunParamsOptsDlg.FillSystemVariablesListView;
var
EnvList: TStringList;
Begin
EnvList:=EnvironmentAsStringList;
FillListView(SystemVariablesListView,EnvList);
EnvList.Free;
end;
procedure TRunParamsOptsDlg.FillUserOverridesListView;
Begin
FillListView(UserOverridesListView,Options.UserOverrides);
end;
end.

7
lcl/include/customlistview.inc
View File

@ -302,6 +302,10 @@ end;
{------------------------------------------------------------------------------}
procedure TCustomListView.SetSelection(const AValue: TListItem);
begin
if FSelected=AValue then exit;
// ToDo: send message to interface
//FSelected := AValue;
//DoSelectItem(FSelected, True);
end;
procedure TCustomListView.SetMultiSelect(const AValue: Boolean);
@ -493,6 +497,9 @@ end;
{ =============================================================================
$Log$
Revision 1.20 2002/08/28 10:44:45 lazarus
MG: implemented run param environment variables
Revision 1.19 2002/05/28 14:58:30 lazarus
MG: added scrollbars for TListView