paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-27 00:44:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

MWE:

Browse Source 
* Upgraded gdb debugger to gdb/mi debugger
  * Set default value for autpopoup
  * Added Clear popup to debugger output window

git-svn-id: trunk@1488 -
This commit is contained in:
lazarus 2002-03-09 02:03:59 +00:00
parent 76b1e2b399
commit 73303926cd
7 changed files with 273 additions and 167 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

213
debugger/cmdlinedebugger.pp
View File

@ -34,23 +34,23 @@ uses
type
TCmdLineDebugger = class(TDebugger)
private
FTargetProcess: TProcess; // The target process to be debugged
FDbgProcess: TProcess; // The process used to call the debugger
FTargetOutputBuf: String; // Tempbuffer for process output
FOutputLines: TStringList; // Debugger output
procedure GetOutput;
FDbgProcess: TProcess; // The process used to call the debugger
FLineEnds: TStringList; // List of strings considered as lineends
FOutputBuf: String;
FReading: Boolean; // Set if we are in the ReadLine loop
FFlushAfterRead: Boolean;// Set if we should flus if we finished reading
function GetDebugProcessRunning: Boolean;
protected
WaitPrompt: String; // Prompt to wait for
procedure CreateDebugProcess(const AName: String);
procedure CreateTargetProcess(const AName: String);
procedure KillTargetProcess;
procedure SendCmdLn(const ACommand: String; const AGetOutput: Boolean); overload;
procedure SendCmdLn(const ACommand: String; Values: array of const; const AGetOutput: Boolean); overload;
property TargetProcess: TProcess read FTargetProcess;
function CreateDebugProcess(const AName: String): Boolean;
procedure Flush; // Flushes output buffer
// procedure KillTargetProcess;
function ReadLine: String; overload;
function ReadLine(const APeek: Boolean): String; overload;
procedure SendCmdLn(const ACommand: String); overload;
procedure SendCmdLn(const ACommand: String; Values: array of const); overload;
property DebugProcess: TProcess read FDbgProcess;
property OutputLines: TStringList read FOutputLines;
property DebugProcessRunning: Boolean read GetDebugProcessRunning;
property LineEnds: TStringList read FLineEnds;
public
constructor Create; {override; }
destructor Destroy; override;
@ -63,6 +63,13 @@ function GetLine(var ABuffer: String): String;
function StripLN(const ALine: String): String;
function GetPart(const ASkipTo, AnEnd: String; var ASource: String): String;
const
{$IFDEF WIN32}
LINE_END = #13#10;
{$ELSE}
LINE_END = #10;
{$ENDIF}
implementation
uses
@ -219,13 +226,14 @@ end;
constructor TCmdLineDebugger.Create;
begin
FDbgProcess := nil;
FTargetProcess := nil;
FOutputLines := TStringList.Create;
FTargetOutputBuf := '';
FLineEnds := TStringList.Create;
FLineEnds.Add(LINE_END);
FReading := False;
FFlushAfterRead := False;
inherited Create;
end;
procedure TCmdLineDebugger.CreateDebugProcess(const AName:String);
function TCmdLineDebugger.CreateDebugProcess(const AName:String): Boolean;
begin
if FDbgProcess = nil
then begin
@ -233,13 +241,17 @@ begin
FDbgProcess.CommandLine := AName;
FDbgProcess.Options:= [poUsePipes, poNoConsole, poStdErrToOutPut];
FDbgProcess.ShowWindow := swoNone;
end;
if not FDbgProcess.Running
then begin
FDbgProcess.Execute;
WriteLn('[TCmdLineDebugger] Debug PID: ', FDbgProcess.Handle);
GetOutput;
end;
Result := FDbgProcess.Running;
end;
procedure TCmdLineDebugger.CreateTargetProcess(const AName:String);
(*
function TCmdLineDebugger.CreateTargetProcess(const AName:String): Boolean;
begin
// TODO: Better cleanup
FTargetProcess.Free;
@ -249,16 +261,13 @@ begin
FTargetProcess.ShowWindow := swoNone;
FTargetProcess.Execute;
WriteLN('[TCmdLineDebugger] Target PID = ', FTargetProcess.Handle);
Result := FTargetProcess.Running;
end;
*)
destructor TCmdLineDebugger.Destroy;
begin
inherited;
try
FTargetProcess.Free;
except
on E: Exception do WriteLN('Exeption while freeing target: ', E.Message);
end;
try
FDbgProcess.Free;
except
@ -266,7 +275,40 @@ begin
end;
end;
procedure TCmdLineDebugger.GetOutput;
procedure TCmdLineDebugger.Flush;
begin
if FReading
then FFlushAfterRead := True
else FOutputBuf := '';
end;
function TCmdLineDebugger.GetDebugProcessRunning: Boolean;
begin
Result := (FDbgProcess <> nil) and FDbgProcess.Running;
end;
(*
procedure TCmdLineDebugger.KillTargetProcess;
begin
if FTargetProcess = nil then Exit;
FTargetProcess.Terminate(0);
FTargetProcess.WaitOnExit;
try
FTargetProcess.Free;
except
on E: Exception do WriteLN('Exeption while freeing target: ', E.Message);
end;
FTargetProcess:= nil;
end;
*)
function TCmdLineDebugger.ReadLine: String;
begin
Result := ReadLine(False);
end;
function TCmdLineDebugger.ReadLine(const APeek: Boolean): String;
function ReadData(const AStream: TStream; var ABuffer: String): Integer;
var
S: String;
@ -281,23 +323,40 @@ procedure TCmdLineDebugger.GetOutput;
end;
var
OutputBuf: String;
Line: String;
OutHandle: Integer;
WaitSet: Integer;
Idx, Count: Integer;
LineEndMatch: String;
n, Idx, MinIdx: Integer;
begin
// WriteLN('[TCmdLineDebugger.GetOutput] Enter');
if (FTargetProcess = nil)
then OutHandle := 0
else OutHandle := FTargetProcess.Output.Handle;
// TODO: get extra handles to wait for
OutputBuf := '';
Line := '';
OutputLines.Clear;
repeat
WaitSet := WaitForHandles([FDbgProcess.Output.Handle, OutHandle]);
FReading := True;
repeat
if FOutputBuf <> ''
then begin
MinIdx := MaxInt;
for n := 0 to FLineEnds.Count - 1 do
begin
LineEndMatch := FLineEnds[n];
Idx := Pos(LineEndMatch, FOutputBuf);
if (idx > 0) and (idx < MinIdx)
then MinIdx := idx;
end;
if MinIdx < MaxInt
then begin
n := MinIdx + Length(LineEndMatch) - 1;
Result := Copy(FOutputBuf, 1, n);
if not APeek
then Delete(FOutputBuf, 1, n);
DoDbgOutput(Result);
Break;
end;
end;
WaitSet := WaitForHandles([FDbgProcess.Output.Handle]);
if WaitSet = 0
then begin
WriteLN('[TCmdLineDebugger.Getoutput] Error waiting ');
@ -305,31 +364,12 @@ begin
Break;
end;
if ((WaitSet and 1) <> 0) and (FDbgProcess <> nil)
then begin
Count := ReadData(FDbgProcess.Output, OutputBuf);
if Count > 0
then while True do
begin
Line := GetLine(OutputBuf);
if Line = ''
then begin
Idx := Pos(WaitPrompt, OutputBuf) - 1;
if (Idx > 0)
and (Idx = Length(OutputBuf) - Length(WaitPrompt))
then begin
// Waitpropmt at end of line, no newline found
Line := Copy(OutputBuf, 1, idx);
Delete(OutputBuf, 1, idx);
end
else Break;
end;
Line := StripLN(Line);
if Line <> '' then FOutputLines.Add(Line);
DoDbgOutput(Line);
end;
end;
if ((WaitSet and 1) <> 0)
and (FDbgProcess <> nil)
and (ReadData(FDbgProcess.Output, FOutputBuf) > 0)
then Continue; // start lineend search
(*
if ((WaitSet and 2) <> 0) and (FTargetProcess <> nil)
then begin
Count := ReadData(FTargetProcess.Output, FTargetOutputBuf);
@ -341,54 +381,45 @@ begin
DoOutput(Line);
end;
end;
until OutputBuf = WaitPrompt;
// WriteLN('[TCmdLineDebugger.GetOutput] Leave');
*)
until not DebugProcessRunning;
FReading := False;
if FFlushAfterRead
then FOutputBuf := '';
FFlushAfterRead := False;
end;
procedure TCmdLineDebugger.KillTargetProcess;
begin
if FTargetProcess = nil then Exit;
FTargetProcess.Terminate(0);
FTargetProcess.WaitOnExit;
try
FTargetProcess.Free;
except
on E: Exception do WriteLN('Exeption while freeing target: ', E.Message);
end;
FTargetProcess:= nil;
end;
procedure TCmdLineDebugger.SendCmdLn(const ACommand: String; const AGetOutput: Boolean); overload;
const
LF = #10;
procedure TCmdLineDebugger.SendCmdLn(const ACommand: String); overload;
begin
if FDbgProcess <> nil
if DebugProcessRunning
then begin
// WriteLN(Format('[TCmdLineDebugger.SendCmd] CMD: <%s>', [ACommand]));
DoDbgOutput('<' + ACommand + '>');
if ACommand <> ''
then FDbgProcess.Input.Write(ACommand[1], Length(ACommand));
FDbgProcess.Input.Write(LF, 1);
if AGetOutput
then GetOutput;
FDbgProcess.Input.Write(LINE_END, 1);
end;
end;
procedure TCmdLineDebugger.SendCmdLn(const ACommand: String; Values: array of const; const AGetOutput: Boolean);
procedure TCmdLineDebugger.SendCmdLn(const ACommand: String; Values: array of const);
begin
SendCmdLn(Format(ACommand, Values), AGetOutput);
SendCmdLn(Format(ACommand, Values));
end;
procedure TCmdLineDebugger.TestCmd(const ACommand: String);
begin
SendCmdLn(ACommand, True);
SendCmdLn(ACommand);
end;
end.
{ =============================================================================
$Log$
Revision 1.7 2002/03/09 02:03:58 lazarus
MWE:
* Upgraded gdb debugger to gdb/mi debugger
* Set default value for autpopoup
* Added Clear popup to debugger output window
Revision 1.6 2002/02/20 23:33:23 lazarus
MWE:
+ Published OnClick for TMenuItem

10
debugger/dbgoutputform.lrc
View File

@ -1,9 +1,9 @@
LazarusResources.Add('TDbgOutputForm','FORMDATA',
'TPF0'#14'TDbgOutputForm'#14'DbgOutputForm1'#7'CAPTION'#6#12'Debug output'
+#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11
+'FormDestroy'#3'TOP'#2#10#4'LEFT'#2#10#6'HEIGHT'#3#200#0#5'WIDTH'#3#144#1
+#0#5'TMemo'#9'txtOutput'#4'Left'#2#8#3'Top'#2'h'#5'Width'#3'X'#2#6'Height'
+#3#150#0#5'Align'#7#8'alClient'#9'PopupMenu'#7#8'mnuPopup'#0#0#10'TPopupM'
+'enu'#8'mnuPopup'#4'Left'#3#144#1#3'Top'#2'`'#0#9'TMenuItem'#8'popClear'#7
+'Caption'#6#6'&Clear'#7'OnClick'#7#13'popClearClick'#0#0#0#0
+'FormDestroy'#6'HEIGHT'#3#200#0#5'WIDTH'#3#144#1#0#5'TMemo'#9'txtOutput'#4
+'Left'#2#8#3'Top'#2'h'#5'Width'#3'X'#2#6'Height'#3#150#0#5'Align'#7#8'alC'
+'lient'#9'PopupMenu'#7#8'mnuPopup'#0#0#10'TPopupMenu'#8'mnuPopup'#4'Left'
+#3#144#1#3'Top'#2'`'#0#9'TMenuItem'#8'popClear'#7'Caption'#6#6'&Clear'#7
+'OnClick'#7#13'popClearClick'#0#0#0#0
);

15
debugger/dbgoutputform.pp
View File

@ -75,7 +75,14 @@ begin
inherited Loaded;
// Not yet through resources
txtOutput.Scrollbars := ssBoth;
txtOutput.Scrollbars := ssBoth;
// Not yet through resources
mnuPopUp.Items.Add(popClear);
// popClear.Caption := '&Clear';
// popClear.OnClick := @popClearClick;
WriteLn('Popupcount: ', mnuPopUp.Items.Count);
WriteLn('Itemvisible ', popClear.Visible);
end;
procedure TDbgOutputForm.popClearClick(Sender: TObject);
@ -89,6 +96,12 @@ initialization
end.
{ =============================================================================
$Log$
Revision 1.3 2002/03/09 02:03:59 lazarus
MWE:
* Upgraded gdb debugger to gdb/mi debugger
* Set default value for autpopoup
* Added Clear popup to debugger output window
Revision 1.2 2002/02/20 23:33:24 lazarus
MWE:
+ Published OnClick for TMenuItem

47
debugger/debugger.pp
View File

@ -213,6 +213,7 @@ type
FArguments: String;
FBreakPoints: TDBGBreakPoints;
FBreakPointGroups: TDBGBreakPointGroups;
FExitCode: Integer;
FFileName: String;
FState: TDBGState;
FWatches: TDBGWatches;
@ -223,6 +224,7 @@ type
FOnState: TNotifyEvent;
function GetState: TDBGState;
function ReqCmd(const ACommand: TDBGCommand; const AParams: array of const): Boolean;
procedure SetFileName(const AValue: String);
protected
function CreateBreakPoints: TDBGBreakPoints; virtual;
function CreateWatches: TDBGWatches; virtual;
@ -231,10 +233,11 @@ type
procedure DoException(const AExceptionID: Integer; const AExceptionText: String);
procedure DoOutput(const AText: String);
procedure DoState;
function ChangeFileName: Boolean; virtual;
function GetCommands: TDBGCommands;
function GetSupportedCommands: TDBGCommands; virtual;
function RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; virtual; abstract; // True if succesful
procedure SetFileName(const AValue: String); virtual;
procedure SetExitCode(const AValue: Integer);
procedure SetState(const AValue: TDBGState);
public
constructor Create; {virtual; Virtual constructor makes no sense}
@ -256,6 +259,7 @@ type
property BreakPointGroups: TDBGBreakPointGroups read FBreakPointGroups; // list of all breakpointgroups
property Commands: TDBGCommands read GetCommands; // All current available commands of the debugger
property FileName: String read FFileName write SetFileName; // The name of the exe to be debugged
property ExitCode: Integer read FExitCode;
property State: TDBGState read FState; // The current state of the debugger
property Watches: TDBGWatches read FWatches; // list of all watches localvars etc
property OnCurrent: TDBGCurrentLineEvent read FOnCurrent write FOnCurrent; // Passes info about the current line being debugged
@ -283,7 +287,12 @@ const
{ =========================================================================== }
{ TDebugger }
{ =========================================================================== }
function TDebugger.ChangeFileName: Boolean;
begin
Result := True;
end;
constructor TDebugger.Create;
begin
inherited Create;
@ -297,6 +306,7 @@ begin
FBreakPoints := CreateBreakPoints;
FWatches := CreateWatches;
FBreakPointGroups := TDBGBreakPointGroups.Create;
FExitCode := 0;
end;
function TDebugger.CreateBreakPoints: TDBGBreakPoints;
@ -371,7 +381,8 @@ begin
end;
procedure TDebugger.Init;
begin
begin
FExitCode := 0;
SetState(dsIdle);
end;
@ -403,18 +414,32 @@ begin
ReqCmd(dcRunTo, [ASource, ALine]);
end;
procedure TDebugger.SetExitCode(const AValue: Integer);
begin
FExitCode := AValue;
end;
procedure TDebugger.SetFileName(const AValue: String);
begin
if FFileName <> AValue
then begin
if FState in [dsRun, dsPause]
then Stop;
// Reset state
FFileName := '';
SetState(dsIdle);
then begin
Stop;
// check if stopped
if FState <> dsStop
then SetState(dsError);
end;
if FState = dsStop
then begin
// Reset state
FFileName := '';
SetState(dsIdle);
end;
FFileName := AValue;
if FFilename <> ''
if (FFilename <> '') and (FState = dsIdle) and ChangeFileName
then SetState(dsStop);
end;
end;
@ -796,6 +821,12 @@ end;
end.
{ =============================================================================
$Log$
Revision 1.9 2002/03/09 02:03:59 lazarus
MWE:
* Upgraded gdb debugger to gdb/mi debugger
* Set default value for autpopoup
* Added Clear popup to debugger output window
Revision 1.8 2002/02/20 23:33:24 lazarus
MWE:
+ Published OnClick for TMenuItem

6
debugger/gdbdebugger.pp
View File

@ -582,6 +582,12 @@ end;
end.
{ =============================================================================
$Log$
Revision 1.8 2002/03/09 02:03:59 lazarus
MWE:
* Upgraded gdb debugger to gdb/mi debugger
* Set default value for autpopoup
* Added Clear popup to debugger output window
Revision 1.7 2002/02/22 13:37:19 lazarus
MG: fixed saving undo limit

4
debugger/tdbgoutputform.lfm
View File

@ -3,8 +3,6 @@ object DbgOutputForm1: TDbgOutputForm
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
TOP = 10
LEFT = 10
HEIGHT = 200
WIDTH = 400
object txtOutput: TMemo
@ -20,7 +18,7 @@ object DbgOutputForm1: TDbgOutputForm
Top = 96
object popClear: TMenuItem
Caption = '&Clear'
OnClick = popClearClick
OnClick = popClearClick
end
end
end

145
ide/main.pp
View File

@ -39,7 +39,7 @@ uses
CustomFormEditor, ObjectInspector, PropEdits, ControlSelection, UnitEditor,
CompilerOptions, EditorOptions, EnvironmentOpts, TransferMacros,
SynEditKeyCmds, KeyMapping, ProjectOpts, IDEProcs, Process, UnitInfoDlg,
Debugger, DBGOutputForm, GDBDebugger, RunParamsOpts, ExtToolDialog,
Debugger, DBGOutputForm, GDBMIDebugger, RunParamsOpts, ExtToolDialog,
MacroPromptDlg, LMessages, ProjectDefs, Watchesdlg, BreakPointsdlg, ColumnDlg,
OutputFilter, BuildLazDialog, MiscOptions, EditDefineTree, CodeToolsOptions,
TypInfo, IDEOptionDefs, CodeToolsDefines;
@ -425,6 +425,7 @@ type
var ActiveUnitInfo:TUnitInfo);
procedure GetUnitWithPageIndex(PageIndex:integer;
var ActiveSourceEditor:TSourceEditor; var ActiveUnitInfo:TUnitInfo);
function FindUnitFile(const AFilename: string): string;
function DoSaveStreamToFile(AStream:TStream; const Filename:string;
IsPartOfProject:boolean): TModalResult;
function DoLoadMemoryStreamFromFile(MemStream: TMemoryStream;
@ -4239,7 +4240,7 @@ begin
then UnitFilename:=ActiveUnitInfo.Filename
else UnitFilename:=GetTestUnitFilename(ActiveUnitInfo);
FDebugger.RunTo(UnitFilename, ActiveSrcEdit.EditorComponent.CaretY);
FDebugger.RunTo(ExtractFilename(UnitFilename), ActiveSrcEdit.EditorComponent.CaretY);
Result := mrOK;
end;
@ -4258,7 +4259,7 @@ begin
case EnvironmentOptions.DebuggerType of
dtGnuDebugger: begin
if (FDebugger <> nil)
and not (FDebugger is TGDBDebugger)
and not (FDebugger is TGDBMIDebugger)
then begin
OldBreakpoints := TDBGBreakpoints.Create(nil, TDBGBreakpoint);
OldBreakpoints.Assign(FBreakPoints);
@ -4274,7 +4275,7 @@ begin
OldBreakpoints := TDBGBreakpoints.Create(nil, TDBGBreakpoint);
OldBreakpoints.Assign(FBreakPoints);
end;
FDebugger := TGDBDebugger.Create;
FDebugger := TGDBMIDebugger.Create;
FBreakPoints := FDebugger.BreakPoints;
end;
if OldBreakpoints <> nil
@ -4357,14 +4358,23 @@ procedure TMainIDE.OnDebuggerCurrentLine(Sender: TObject;
// if SrcLine = -1 then no source is available
var
ActiveSrcEdit: TSourceEditor;
UnitFile: String;
begin
if (Sender<>FDebugger) or (Sender=nil) then exit;
//TODO: Show assembler window if no source can be found.
if ALocation.SrcLine = -1 then Exit;
if DoOpenEditorFile(ALocation.SrcFile,false,true) <> mrOk then exit;
ActiveSrcEdit:=SourceNoteBook.GetActiveSE;
if ALocation.SrcLine = -1 then Exit;
UnitFile := FindUnitFile(ALocation.SrcFile);
if UnitFile = ''
then UnitFile := ALocation.SrcFile;
if DoOpenEditorFile(UnitFile, False, True) <> mrOk then exit;
ActiveSrcEdit := SourceNoteBook.GetActiveSE;
if ActiveSrcEdit=nil then exit;
with ActiveSrcEdit.EditorComponent do begin
with ActiveSrcEdit.EditorComponent do
begin
CaretXY:=Point(1, ALocation.SrcLine);
BlockBegin:=CaretXY;
BlockEnd:=CaretXY;
@ -4804,54 +4814,8 @@ end;
function TMainIDE.DoJumpToCompilerMessage(Index:integer;
FocusEditor: boolean): boolean;
function SearchFile(const AFilename: string): string;
var OldCurrDir, SearchPath, Delimiter, ProjectDir: string;
PathStart, PathEnd: integer;
begin
if FilenameIsAbsolute(AFilename) then begin
Result:=AFileName;
exit;
end;
// search file in project directory
if (Project.MainUnit>=0) and Project.Units[Project.MainUnit].IsVirtual then
begin
Result:=AFilename;
exit;
end;
ProjectDir:=ExtractFilePath(Project.ProjectFile);
Result:=ProjectDir+AFilename;
if FileExists(Result) then exit;
// search file with unit search path
OldCurrDir:=GetCurrentDir;
try
SetCurrentDir(ProjectDir);
Delimiter:=';';
SearchPath:=Project.CompilerOptions.OtherUnitFiles+';'+Project.SrcPath;
PathStart:=1;
while (PathStart<=length(SearchPath)) do begin
while (PathStart<=length(SearchPath))
and (Pos(SearchPath[PathStart],Delimiter)>0) do
inc(PathStart);
PathEnd:=PathStart;
while (PathEnd<=length(SearchPath))
and (Pos(SearchPath[PathEnd],Delimiter)<1) do
inc(PathEnd);
if PathEnd>PathStart then begin
Result:=ExpandFileName(copy(SearchPath,PathStart,PathEnd-PathStart));
if Result<>'' then begin
if Result[length(Result)]<>PathDelim then
Result:=Result+PathDelim;
Result:=Result+AFileName;
if FileExists(Result) then exit;
end;
end;
PathStart:=PathEnd;
end;
finally
SetCurrentDir(OldCurrDir);
end;
Result:='';
end;
// function SearchFile(const AFilename: string): string;
// Moved to FindUnitFile method
var MaxMessages: integer;
Filename, Ext, SearchedFilename: string;
@ -4880,7 +4844,7 @@ begin
end;
if TheOutputFilter.GetSourcePosition(MessagesView.MessageView.Items[Index],
Filename,CaretXY,MsgType) then begin
SearchedFilename:=SearchFile(Filename);
SearchedFilename := FindUnitFile(Filename);
if SearchedFilename<>'' then begin
// open the file in the source editor
Ext:=lowercase(ExtractFileExt(SearchedFilename));
@ -4998,6 +4962,63 @@ begin
Result:=ExtractFilename(AnUnitInfo.Filename);
if Result='' then exit;
Result:=TestDir+Result;
end;
function TMainIDE.FindUnitFile(const AFilename: string): string;
var
OldCurrDir, SearchPath, Delimiter, ProjectDir: string;
PathStart, PathEnd: integer;
begin
if FilenameIsAbsolute(AFilename)
then begin
Result:=AFileName;
exit;
end;
// search file in project directory
if (Project.MainUnit>=0) and Project.Units[Project.MainUnit].IsVirtual
then begin
Result:=AFilename;
exit;
end;
ProjectDir:=ExtractFilePath(Project.ProjectFile);
Result:=ProjectDir+AFilename;
if FileExists(Result) then exit;
// search file with unit search path
OldCurrDir:=GetCurrentDir;
try
SetCurrentDir(ProjectDir);
Delimiter:=';';
SearchPath:=Project.CompilerOptions.OtherUnitFiles+';'+Project.SrcPath;
PathStart:=1;
while (PathStart<=length(SearchPath)) do
begin
while (PathStart<=length(SearchPath))
and (Pos(SearchPath[PathStart],Delimiter)>0) do
inc(PathStart);
PathEnd:=PathStart;
while (PathEnd<=length(SearchPath))
and (Pos(SearchPath[PathEnd],Delimiter)<1) do
inc(PathEnd);
if PathEnd>PathStart
then begin
Result:=ExpandFileName(copy(SearchPath,PathStart,PathEnd-PathStart));
if Result<>''
then begin
if Result[length(Result)]<>PathDelim
then Result:=Result+PathDelim;
Result:=Result+AFileName;
if FileExists(Result) then exit;
end;
end;
PathStart:=PathEnd;
end;
finally
SetCurrentDir(OldCurrDir);
end;
Result:='';
end;
//------------------------------------------------------------------------------
@ -5852,7 +5873,7 @@ begin
Breakpoints_Dlg.AddBreakPoint(TSourceNotebook(sender).GetActiveSe.FileName,Line);
NewBreak := FBreakPoints.Add(TSourceNotebook(sender).GetActiveSe.FileName, Line);
NewBreak := FBreakPoints.Add(ExtractFilename(TSourceNotebook(sender).GetActiveSe.FileName), Line);
NewBreak.Enabled := True;
end;
@ -5862,7 +5883,7 @@ begin
if SourceNotebook.Notebook = nil then Exit;
Breakpoints_Dlg.DeleteBreakPoint(TSourceNotebook(sender).GetActiveSe.FileName,Line);
FBreakPoints.Find(TSourceNotebook(sender).GetActiveSe.FileName, Line).Free;
FBreakPoints.Find(ExtractFilename(TSourceNotebook(sender).GetActiveSe.FileName), Line).Free;
end;
procedure TMainIDE.OnExtToolNeedsOutputFilter(var OutputFilter: TOutputFilter;
@ -6224,6 +6245,12 @@ end.
{ =============================================================================
$Log$
Revision 1.243 2002/03/09 02:03:57 lazarus
MWE:
* Upgraded gdb debugger to gdb/mi debugger
* Set default value for autpopoup
* Added Clear popup to debugger output window
Revision 1.242 2002/03/08 11:37:40 lazarus
MG: outputfilter can now find include files