272 lines
10 KiB
ObjectPascal
272 lines
10 KiB
ObjectPascal
|
{**************************************************************************************************}
|
||
|
|
{ }
|
||
|
|
{ Project JEDI Code Library (JCL) }
|
||
|
|
{ }
|
||
|
|
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
|
||
|
|
{ you may not use this file except in compliance with the License. You may obtain a copy of the }
|
||
|
|
{ License at http://www.mozilla.org/MPL/ }
|
||
|
|
{ }
|
||
|
|
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
|
||
|
|
{ ANY KIND, either express or implied. See the License for the specific language governing rights }
|
||
|
|
{ and limitations under the License. }
|
||
|
|
{ }
|
||
|
|
{ The Original Code is JclStackTraceViewerStackFrame.pas. }
|
||
|
|
{ }
|
||
|
|
{ The Initial Developer of the Original Code is Uwe Schuster. }
|
||
|
|
{ Portions created by Uwe Schuster are Copyright (C) 2009 Uwe Schuster. All rights reserved. }
|
||
|
|
{ }
|
||
|
|
{ Contributor(s): }
|
||
|
|
{ Uwe Schuster (uschuster) }
|
||
|
|
{ }
|
||
|
|
{**************************************************************************************************}
|
||
|
|
{ }
|
||
|
|
{ Last modified: $Date:: 2009-09-14 18:00:50 +0200 (lun., 14 sept. 2009) $ }
|
||
|
|
{ Revision: $Rev:: 3012 $ }
|
||
|
|
{ Author: $Author:: outchy $ }
|
||
|
|
{ }
|
||
|
|
{**************************************************************************************************}
|
||
|
|
|
||
|
|
unit JclStackTraceViewerStackFrame;
|
||
|
|
|
||
|
|
{$I jcl.inc}
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
||
|
|
ComCtrls, IniFiles,
|
||
|
|
{$IFDEF UNITVERSIONING}
|
||
|
|
JclUnitVersioning,
|
||
|
|
{$ENDIF UNITVERSIONING}
|
||
|
|
JclDebug, JclStackTraceViewerAPI, JclStackTraceViewerStackCodeUtils;
|
||
|
|
|
||
|
|
type
|
||
|
|
TfrmStack = class(TFrame, IJclStackTraceViewerStackFrame, IJclStackTraceViewerPreparableStackFrame,
|
||
|
|
IJclStackTraceViewerStackSelection)
|
||
|
|
lv: TListView;
|
||
|
|
procedure lvDblClick(Sender: TObject);
|
||
|
|
procedure lvChange(Sender: TObject; Item: TListItem; Change: TItemChange);
|
||
|
|
private
|
||
|
|
FStackList: IJclLocationInfoList;
|
||
|
|
FOnSelectStackLine: TNotifyEvent;
|
||
|
|
procedure DoSelectStackLine;
|
||
|
|
procedure UpdateListView;
|
||
|
|
public
|
||
|
|
constructor Create(AOwner: TComponent); override;
|
||
|
|
procedure LoadState(AIni: TCustomIniFile; const ASection, APrefix: string);
|
||
|
|
procedure SaveState(AIni: TCustomIniFile; const ASection, APrefix: string);
|
||
|
|
{ IJclStackTraceViewerStackFrame }
|
||
|
|
function GetStackList: IJclLocationInfoList;
|
||
|
|
procedure SetStackList(const Value: IJclLocationInfoList);
|
||
|
|
procedure UpdateView;
|
||
|
|
{ IJclStackTraceViewerPreparableStackFrame }
|
||
|
|
function GetPreparableLocationInfoListCount: Integer;
|
||
|
|
function GetPreparableLocationInfoList(AIndex: Integer): IJclPreparedLocationInfoList;
|
||
|
|
procedure UpdateViews;
|
||
|
|
property StackList: IJclLocationInfoList read FStackList write SetStackList;
|
||
|
|
property OnSelectStackLine: TNotifyEvent read FOnSelectStackLine write FOnSelectStackLine;
|
||
|
|
{ IJclStackTraceViewerStackSelection }
|
||
|
|
function GetSelected: IJclLocationInfo;
|
||
|
|
property Selected: IJclLocationInfo read GetSelected;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$IFDEF UNITVERSIONING}
|
||
|
|
const
|
||
|
|
UnitVersioning: TUnitVersionInfo = (
|
||
|
|
RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-2.1-Build3536/jcl/experts/stacktraceviewer/JclStackTraceViewerStackFrame.pas $';
|
||
|
|
Revision: '$Revision: 3012 $';
|
||
|
|
Date: '$Date: 2009-09-14 18:00:50 +0200 (lun., 14 sept. 2009) $';
|
||
|
|
LogPath: 'JCL\experts\stacktraceviewer';
|
||
|
|
Extra: '';
|
||
|
|
Data: nil
|
||
|
|
);
|
||
|
|
{$ENDIF UNITVERSIONING}
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
{$R *.dfm}
|
||
|
|
|
||
|
|
uses
|
||
|
|
JclOtaResources;
|
||
|
|
|
||
|
|
{ TfrmStack }
|
||
|
|
|
||
|
|
constructor TfrmStack.Create(AOwner: TComponent);
|
||
|
|
begin
|
||
|
|
inherited Create(AOwner);
|
||
|
|
lv.Columns.Items[0].Caption := LoadResString(@RsStackModuleName);
|
||
|
|
lv.Columns.Items[0].Caption := LoadResString(@RsSourceUnitName);
|
||
|
|
lv.Columns.Items[0].Caption := LoadResString(@RsProcedureName);
|
||
|
|
lv.Columns.Items[0].Caption := LoadResString(@RsSourceName);
|
||
|
|
lv.Columns.Items[0].Caption := LoadResString(@RsLineNumber);
|
||
|
|
lv.Columns.Items[0].Caption := LoadResString(@RsLineNumberOffsetFromProcedureStart);
|
||
|
|
lv.Columns.Items[0].Caption := LoadResString(@RsRevision);
|
||
|
|
lv.Columns.Items[0].Caption := LoadResString(@RsProjectFile);
|
||
|
|
lv.Columns.Items[0].Caption := LoadResString(@RsTranslatedLineNumber);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmStack.DoSelectStackLine;
|
||
|
|
begin
|
||
|
|
if Assigned(FOnSelectStackLine) then
|
||
|
|
FOnSelectStackLine(Self);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrmStack.GetPreparableLocationInfoList(AIndex: Integer): IJclPreparedLocationInfoList;
|
||
|
|
begin
|
||
|
|
if AIndex = 0 then
|
||
|
|
begin
|
||
|
|
if FStackList.QueryInterface(IJclPreparedLocationInfoList, Result) <> S_OK then
|
||
|
|
Result := nil;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
Result := nil;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrmStack.GetPreparableLocationInfoListCount: Integer;
|
||
|
|
var
|
||
|
|
Dummy: IJclPreparedLocationInfoList;
|
||
|
|
begin
|
||
|
|
if Assigned(FStackList) and (FStackList.QueryInterface(IJclPreparedLocationInfoList, Dummy) = S_OK) then
|
||
|
|
Result := 1
|
||
|
|
else
|
||
|
|
Result := 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrmStack.GetSelected: IJclLocationInfo;
|
||
|
|
begin
|
||
|
|
if not (Assigned(lv.Selected) and Assigned(lv.Selected.Data) and
|
||
|
|
(IUnknown(lv.Selected.Data).QueryInterface(IJclLocationInfo, Result) = S_OK)) then
|
||
|
|
Result := nil;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrmStack.GetStackList: IJclLocationInfoList;
|
||
|
|
begin
|
||
|
|
Result := FStackList;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmStack.LoadState(AIni: TCustomIniFile; const ASection, APrefix: string);
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
begin
|
||
|
|
for I := 0 to lv.Columns.Count - 1 do
|
||
|
|
lv.Columns.Items[I].Width := AIni.ReadInteger(ASection,
|
||
|
|
Format(APrefix + 'ColumnWidth%d', [I]), lv.Columns.Items[I].Width);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmStack.lvChange(Sender: TObject; Item: TListItem; Change: TItemChange);
|
||
|
|
begin
|
||
|
|
DoSelectStackLine;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmStack.lvDblClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
JumpToCode(GetSelected);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmStack.SaveState(AIni: TCustomIniFile; const ASection, APrefix: string);
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
begin
|
||
|
|
for I := 0 to lv.Columns.Count - 1 do
|
||
|
|
AIni.WriteInteger(ASection, Format(APrefix + 'ColumnWidth%d', [I]), lv.Columns.Items[I].Width);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmStack.SetStackList(const Value: IJclLocationInfoList);
|
||
|
|
begin
|
||
|
|
FStackList := Value;
|
||
|
|
UpdateListView;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmStack.UpdateListView;
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
ListItem: TListItem;
|
||
|
|
S: string;
|
||
|
|
PreparedLocationInfo: IJclPreparedLocationInfo;
|
||
|
|
LocationInfo: IJclLocationInfo;
|
||
|
|
FixProcedureName: Boolean;
|
||
|
|
begin
|
||
|
|
lv.Items.BeginUpdate;
|
||
|
|
try
|
||
|
|
lv.Items.Clear;
|
||
|
|
if Assigned(FStackList) then
|
||
|
|
begin
|
||
|
|
FixProcedureName := True;
|
||
|
|
for I := 0 to FStackList.Count - 1 do
|
||
|
|
begin
|
||
|
|
LocationInfo := FStackList[I];
|
||
|
|
if (LocationInfo.SourceUnitName <> '') and
|
||
|
|
(Pos(LocationInfo.SourceUnitName + '.', LocationInfo.ProcedureName) <> 1) then
|
||
|
|
begin
|
||
|
|
FixProcedureName := False;
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
for I := 0 to FStackList.Count - 1 do
|
||
|
|
begin
|
||
|
|
ListItem := lv.Items.Add;
|
||
|
|
ListItem.Caption := FStackList[I].ModuleName;
|
||
|
|
ListItem.SubItems.Add(FStackList[I].SourceUnitName);
|
||
|
|
S := FStackList[I].ProcedureName;
|
||
|
|
if FixProcedureName and (FStackList[I].SourceUnitName <> '') then
|
||
|
|
Delete(S, 1, Length(FStackList[I].SourceUnitName) + 1);
|
||
|
|
ListItem.SubItems.Add(S);
|
||
|
|
ListItem.SubItems.Add(FStackList[I].SourceName);
|
||
|
|
if FStackList[I].LineNumber > 0 then
|
||
|
|
S := IntToStr(FStackList[I].LineNumber)
|
||
|
|
else
|
||
|
|
S := '';
|
||
|
|
ListItem.SubItems.Add(S);
|
||
|
|
if FStackList[I].Values and livProcedureStartLocationInfo <> 0 then
|
||
|
|
S := IntToStr(FStackList[I].LineNumberOffsetFromProcedureStart)
|
||
|
|
else
|
||
|
|
S := '';
|
||
|
|
ListItem.SubItems.Add(S);
|
||
|
|
if FStackList[I].QueryInterface(IJclPreparedLocationInfo, PreparedLocationInfo) = S_OK then
|
||
|
|
begin
|
||
|
|
ListItem.SubItems.Add(PreparedLocationInfo.Revision);
|
||
|
|
if PreparedLocationInfo.ProjectName <> '' then
|
||
|
|
S := ExtractFileName(PreparedLocationInfo.ProjectName)
|
||
|
|
else
|
||
|
|
S := ExtractFileName(PreparedLocationInfo.FileName);
|
||
|
|
ListItem.SubItems.Add(S);
|
||
|
|
if PreparedLocationInfo.TranslatedLineNumber > 0 then
|
||
|
|
S := IntToStr(PreparedLocationInfo.TranslatedLineNumber)
|
||
|
|
else
|
||
|
|
S := '';
|
||
|
|
ListItem.SubItems.Add(S);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
ListItem.SubItems.Add('');
|
||
|
|
ListItem.SubItems.Add('');
|
||
|
|
ListItem.SubItems.Add('');
|
||
|
|
end;
|
||
|
|
ListItem.Data := Pointer(FStackList[I]);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
lv.Items.EndUpdate;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmStack.UpdateView;
|
||
|
|
begin
|
||
|
|
UpdateListView;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmStack.UpdateViews;
|
||
|
|
begin
|
||
|
|
UpdateView;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$IFDEF UNITVERSIONING}
|
||
|
|
initialization
|
||
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
||
|
|
|
||
|
|
finalization
|
||
|
|
UnregisterUnitVersion(HInstance);
|
||
|
|
{$ENDIF UNITVERSIONING}
|
||
|
|
|
||
|
|
end.
|