1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334
|
{ $Id$ }
{ ------------------------------------------
debugeventsform.pp - Shows target output
------------------------------------------
@created(Wed Mar 1st 2010)
@lastmod($Date$)
@author Lazarus Project
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
* *
***************************************************************************
}
unit DebugEventsForm;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
// LCL
Controls, ComCtrls, ActnList, StdActns, ClipBrd, Menus, Dialogs,
// LazUtils
LazFileUtils,
// IdeIntf
IDEWindowIntf, IDEImagesIntf, LazIDEIntf, InputHistory,
// DebuggerIntf
DbgIntfDebuggerBase,
// IdeDebugger
BaseDebugManager, Debugger, DebuggerDlg, IdeDebuggerStringConstants, EnvDebuggerOptions,
// IDE
debugger_eventlog_options;
type
{ TDbgEventsForm }
TDbgEventsForm = class(TDebuggerDlg)
actClear: TAction;
actAddComment: TAction;
actOptions: TAction;
actSave: TAction;
ActionList1: TActionList;
EditCopy1: TEditCopy;
imlMain: TImageList;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
PopupMenu1: TPopupMenu;
tvFilteredEvents: TTreeView;
procedure actAddCommentExecute(Sender: TObject);
procedure actClearExecute(Sender: TObject);
procedure actOptionsExecute(Sender: TObject);
procedure actSaveExecute(Sender: TObject);
procedure EditCopy1Execute(Sender: TObject);
procedure EditCopy1Update(Sender: TObject);
procedure tvFilteredEventsAdvancedCustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
var {%H-}PaintImages, DefaultDraw: Boolean);
private
function GetFilter: TDBGEventCategories;
private
FEvents: TStringList;
procedure UpdateFilteredList;
property Filter: TDBGEventCategories read GetFilter;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetEvents(const AEvents: TStrings);
procedure GetEvents(const AResultEvents: TStrings);
procedure Clear;
procedure AddEvent(const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
end;
implementation
{$R *.lfm}
var
EventsDlgWindowCreator: TIDEWindowCreator;
type
TCustomTreeViewAccess = class(TCustomTreeView);
{ TDbgEventsForm }
procedure TDbgEventsForm.tvFilteredEventsAdvancedCustomDrawItem(
Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState;
Stage: TCustomDrawStage; var PaintImages, DefaultDraw: Boolean);
var
Rec: TDBGEventRec;
NodeRect, TextRect: TRect;
TextY: Integer;
begin
DefaultDraw := Stage <> cdPrePaint;
if DefaultDraw then Exit;
Rec.Ptr := Node.Data;
if cdsSelected in State then
begin
Sender.Canvas.Brush.Color := EnvironmentDebugOpts.DebuggerEventLogColors[TDBGEventType(Rec.EventType)].Foreground;
Sender.Canvas.Font.Color := EnvironmentDebugOpts.DebuggerEventLogColors[TDBGEventType(Rec.EventType)].Background;
end
else
begin
Sender.Canvas.Brush.Color := EnvironmentDebugOpts.DebuggerEventLogColors[TDBGEventType(Rec.EventType)].Background;
Sender.Canvas.Font.Color := EnvironmentDebugOpts.DebuggerEventLogColors[TDBGEventType(Rec.EventType)].Foreground;
end;
NodeRect := Node.DisplayRect(False);
TextRect := Node.DisplayRect(True);
TextY := (TextRect.Top + TextRect.Bottom - Sender.Canvas.TextHeight(Node.Text)) div 2;
Sender.Canvas.FillRect(NodeRect);
imlMain.Draw(Sender.Canvas, TCustomTreeViewAccess(Sender).Indent shr 2 + 1 - TCustomTreeViewAccess(Sender).ScrolledLeft, (NodeRect.Top + NodeRect.Bottom - imlMain.Height) div 2,
Node.ImageIndex, True);
Sender.Canvas.TextOut(TextRect.Left, TextY, Node.Text);
end;
function TDbgEventsForm.GetFilter: TDBGEventCategories;
begin
Result := [];
if EnvironmentDebugOpts.DebuggerEventLogShowBreakpoint then
Include(Result, ecBreakpoint);
if EnvironmentDebugOpts.DebuggerEventLogShowProcess then
Include(Result, ecProcess);
if EnvironmentDebugOpts.DebuggerEventLogShowThread then
Include(Result, ecThread);
if EnvironmentDebugOpts.DebuggerEventLogShowModule then
Include(Result, ecModule);
if EnvironmentDebugOpts.DebuggerEventLogShowOutput then
Include(Result, ecOutput);
if EnvironmentDebugOpts.DebuggerEventLogShowWindows then
Include(Result, ecWindows);
if EnvironmentDebugOpts.DebuggerEventLogShowDebugger then
Include(Result, ecDebugger);
end;
procedure TDbgEventsForm.EditCopy1Execute(Sender: TObject);
begin
Clipboard.Open;
Clipboard.AsText := tvFilteredEvents.Selected.Text;
Clipboard.Close;
end;
procedure TDbgEventsForm.actClearExecute(Sender: TObject);
begin
Clear;
end;
procedure TDbgEventsForm.actOptionsExecute(Sender: TObject);
begin
LazarusIDE.DoOpenIDEOptions(TDebuggerEventLogOptionsFrame);
end;
procedure TDbgEventsForm.actAddCommentExecute(Sender: TObject);
var
S: String;
begin
S := '';
if InputQuery(lisMenuViewDebugEvents, lisEventsLogAddComment2, S) then
AddEvent(ecDebugger, etDefault, S);
end;
procedure TDbgEventsForm.actSaveExecute(Sender: TObject);
var
SaveDialog: TSaveDialog;
AFilename: String;
begin
SaveDialog := TSaveDialog.Create(nil);
try
InputHistories.ApplyFileDialogSettings(SaveDialog);
SaveDialog.Title := lisMVSaveMessagesToFileTxt;
SaveDialog.Options := SaveDialog.Options + [ofPathMustExist];
if SaveDialog.Execute then
begin
AFilename := CleanAndExpandFilename(SaveDialog.Filename);
if ExtractFileExt(AFilename) = '' then
AFilename := AFilename + '.txt';
FEvents.SaveToFile(AFilename);
end;
InputHistories.StoreFileDialogSettings(SaveDialog);
finally
SaveDialog.Free;
end;
end;
procedure TDbgEventsForm.EditCopy1Update(Sender: TObject);
begin
EditCopy1.Enabled := Assigned(tvFilteredEvents.Selected);
end;
procedure TDbgEventsForm.UpdateFilteredList;
const
CategoryImages: array [TDBGEventCategory] of Integer = (
{ ecBreakpoint } 0,
{ ecProcess } 1,
{ ecThread } 2,
{ ecModule } 3,
{ ecOutput } 4,
{ ecWindows } 5,
{ ecDebugger } 6
);
var
i: Integer;
Item: TTreeNode;
Rec: TDBGEventRec;
Cat: TDBGEventCategory;
begin
tvFilteredEvents.BeginUpdate;
try
tvFilteredEvents.Items.Clear;
for i := 0 to FEvents.Count -1 do
begin
Rec.Ptr := FEvents.Objects[i];
Cat := TDBGEventCategory(Rec.Category);
if Cat in Filter then
begin
Item := tvFilteredEvents.Items.AddChild(nil, FEvents[i]);
Item.Data := FEvents.Objects[i];
Item.ImageIndex := CategoryImages[Cat];
Item.SelectedIndex := CategoryImages[Cat];
end;
end;
finally
tvFilteredEvents.EndUpdate;
end;
// To be a smarter and restore the active Item, we would have to keep a link
//between the lstFilteredEvents item and FEvents index, and account items
//removed from FEvents because of log limit.
// Also, TopItem and GetItemAt(0,0) both return nil in gtk2.
if tvFilteredEvents.Items.Count <> 0 then
begin
tvFilteredEvents.Items[tvFilteredEvents.Items.Count - 1].MakeVisible;
tvFilteredEvents.Selected := tvFilteredEvents.Items[tvFilteredEvents.Items.Count - 1];
end;
end;
procedure TDbgEventsForm.SetEvents(const AEvents: TStrings);
begin
if AEvents <> nil then
FEvents.Assign(AEvents)
else
FEvents.Clear;
UpdateFilteredList;
end;
procedure TDbgEventsForm.GetEvents(const AResultEvents: TStrings);
begin
AResultEvents.Assign(FEvents);
end;
procedure TDbgEventsForm.Clear;
begin
FEvents.Clear;
tvFilteredEvents.Items.Clear;
end;
constructor TDbgEventsForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Caption := lisMenuViewDebugEvents;
actClear.Caption := lisEventLogClear;
actSave.Caption := lisEventLogSaveToFile;
actAddComment.Caption := lisEventsLogAddComment;
actOptions.Caption := lisEventLogOptions;
FEvents := TStringList.Create;
PopupMenu1.Images := IDEImages.Images_16;
actOptions.ImageIndex := IDEImages.LoadImage('menu_environment_options');
end;
destructor TDbgEventsForm.Destroy;
begin
FreeAndNil(FEvents);
inherited Destroy;
end;
procedure TDbgEventsForm.AddEvent(const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
var
Item: TTreeNode;
Rec: TDBGEventRec;
begin
if EnvironmentDebugOpts.DebuggerEventLogCheckLineLimit then
begin
tvFilteredEvents.BeginUpdate;
try
while tvFilteredEvents.Items.Count >= EnvironmentDebugOpts.DebuggerEventLogLineLimit do
tvFilteredEvents.Items.Delete(tvFilteredEvents.Items[0]);
finally
tvFilteredEvents.EndUpdate;
end;
end;
Rec.Category := Ord(ACategory);
Rec.EventType := Ord(AEventType);
FEvents.AddObject(AText, TObject(Rec.Ptr));
if ACategory in Filter then
begin
Item := tvFilteredEvents.Items.AddChild(nil, AText);
Item.ImageIndex := Rec.Category;
Item.SelectedIndex := Rec.Category;
Item.Data := Rec.Ptr;
Item.MakeVisible;
tvFilteredEvents.Selected := Item;
end;
end;
initialization
EventsDlgWindowCreator := IDEWindowCreators.Add(DebugDialogNames[ddtEvents]);
EventsDlgWindowCreator.OnCreateFormProc := @CreateDebugDialog;
EventsDlgWindowCreator.CreateSimpleLayout;
end.
|