271 lines
9.7 KiB
ObjectPascal
271 lines
9.7 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 JclStackTraceViewerStackCodeUtils.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-08-25 20:22:46 +0200 (mar., 25 août 2009) $ }
|
||
|
|
{ Revision: $Rev:: 2969 $ }
|
||
|
|
{ Author: $Author:: outchy $ }
|
||
|
|
{ }
|
||
|
|
{**************************************************************************************************}
|
||
|
|
|
||
|
|
unit JclStackTraceViewerStackCodeUtils;
|
||
|
|
|
||
|
|
{$I jcl.inc}
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
SysUtils,
|
||
|
|
{$IFNDEF BDS}
|
||
|
|
Windows, Classes,
|
||
|
|
{$ENDIF ~BDS}
|
||
|
|
ActiveX, ToolsAPI,
|
||
|
|
{$IFDEF UNITVERSIONING}
|
||
|
|
JclUnitVersioning,
|
||
|
|
{$ENDIF UNITVERSIONING}
|
||
|
|
JclOtaUtils,
|
||
|
|
JclStackTraceViewerAPI;
|
||
|
|
|
||
|
|
function FindModule(const AFileName: string): string;
|
||
|
|
function FindModuleAndProject(const AFileName: string; var AProjectName: string): string;
|
||
|
|
function GetFileEditorContent(const AFileName: string): IStream;
|
||
|
|
procedure JumpToCode(AStackViewItem: IJclLocationInfo);
|
||
|
|
|
||
|
|
{$IFDEF UNITVERSIONING}
|
||
|
|
const
|
||
|
|
UnitVersioning: TUnitVersionInfo = (
|
||
|
|
RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-2.1-Build3536/jcl/experts/stacktraceviewer/JclStackTraceViewerStackCodeUtils.pas $';
|
||
|
|
Revision: '$Revision: 2969 $';
|
||
|
|
Date: '$Date: 2009-08-25 20:22:46 +0200 (mar., 25 août 2009) $';
|
||
|
|
LogPath: 'JCL\experts\stacktraceviewer';
|
||
|
|
Extra: '';
|
||
|
|
Data: nil
|
||
|
|
);
|
||
|
|
{$ENDIF UNITVERSIONING}
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
function FindModuleInfoInProject(AProject: IOTAProject; const AFileName: string): IOTAModuleInfo;
|
||
|
|
var
|
||
|
|
I, P: Integer;
|
||
|
|
ModuleInfo: IOTAModuleInfo;
|
||
|
|
S, S2: string;
|
||
|
|
begin
|
||
|
|
Result := nil;
|
||
|
|
if AProject.GetModuleCount > 0 then
|
||
|
|
begin
|
||
|
|
S := UpperCase(AFileName);
|
||
|
|
for I := 0 to Pred(AProject.GetModuleCount) do
|
||
|
|
begin
|
||
|
|
ModuleInfo := AProject.GetModule(I);
|
||
|
|
if Assigned(ModuleInfo) then
|
||
|
|
begin
|
||
|
|
S2 := UpperCase(ModuleInfo.FileName);
|
||
|
|
P := Pos(S, S2);
|
||
|
|
if (P > 0) and (P = Length(S2) - Length(S) + 1) then
|
||
|
|
begin
|
||
|
|
Result := ModuleInfo;
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function FindModule(const AFileName: string): string;
|
||
|
|
var
|
||
|
|
Dummy: string;
|
||
|
|
begin
|
||
|
|
Result := FindModuleAndProject(AFilename, Dummy);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function FindModuleInfoAndProject(const AFileName: string; var AProjectName: string): IOTAModuleInfo;
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
ProjectGroup: IOTAProjectGroup;
|
||
|
|
begin
|
||
|
|
Result := nil;
|
||
|
|
AProjectName := '';
|
||
|
|
{$IFDEF BDS}
|
||
|
|
ProjectGroup := (BorlandIDEServices as IOTAModuleServices).MainProjectGroup;
|
||
|
|
{$ELSE ~BDS}
|
||
|
|
ProjectGroup := TJclOTAExpertBase.GetProjectGroup;
|
||
|
|
{$ENDIF ~BDS}
|
||
|
|
if Assigned(ProjectGroup) then
|
||
|
|
for I := 0 to ProjectGroup.ProjectCount - 1 do
|
||
|
|
begin
|
||
|
|
Result := FindModuleInfoInProject(ProjectGroup.Projects[I], AFileName);
|
||
|
|
if Assigned(Result) then
|
||
|
|
begin
|
||
|
|
AProjectName := ProjectGroup.Projects[I].FileName;
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function FindModuleAndProject(const AFileName: string; var AProjectName: string): string;
|
||
|
|
var
|
||
|
|
ModuleInfo: IOTAModuleInfo;
|
||
|
|
begin
|
||
|
|
ModuleInfo := FindModuleInfoAndProject(AFileName, AProjectName);
|
||
|
|
if Assigned(ModuleInfo) then
|
||
|
|
Result := ModuleInfo.FileName
|
||
|
|
else
|
||
|
|
Result := '';
|
||
|
|
end;
|
||
|
|
|
||
|
|
function GetFileEditorContent(const AFileName: string): IStream;
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
Module: IOTAModule;
|
||
|
|
{$IFDEF BDS}
|
||
|
|
EditorContent: IOTAEditorContent;
|
||
|
|
{$ELSE ~BDS}
|
||
|
|
ContentPos, ReadCount, BufferSize: Integer;
|
||
|
|
Buffer: Pointer;
|
||
|
|
ModuleSourceEditor: IOTASourceEditor;
|
||
|
|
ModuleReader: IOTAEditReader;
|
||
|
|
S: TStream;
|
||
|
|
SA: TStreamAdapter;
|
||
|
|
{$ENDIF ~BDS}
|
||
|
|
begin
|
||
|
|
Result := nil;
|
||
|
|
Module := (BorlandIDEServices as IOTAModuleServices).FindModule(AFileName);
|
||
|
|
if Assigned(Module) then
|
||
|
|
begin
|
||
|
|
{$IFDEF BDS}
|
||
|
|
for I := 0 to Module.ModuleFileCount - 1 do
|
||
|
|
if Supports(Module.ModuleFileEditors[I], IOTAEditorContent, EditorContent) then
|
||
|
|
begin
|
||
|
|
Result := EditorContent.Content;
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
{$ELSE ~BDS}
|
||
|
|
for I := 0 to Module.GetModuleFileCount - 1 do
|
||
|
|
if Supports(Module.GetModuleFileEditor(I), IOTASourceEditor, ModuleSourceEditor) then
|
||
|
|
begin
|
||
|
|
ModuleReader := ModuleSourceEditor.CreateReader;
|
||
|
|
if Assigned(ModuleReader) then
|
||
|
|
begin
|
||
|
|
ContentPos := 0;
|
||
|
|
BufferSize := 4096;
|
||
|
|
SA := TStreamAdapter.Create(TMemoryStream.Create, soOwned);
|
||
|
|
S := SA.Stream;
|
||
|
|
Result := SA;
|
||
|
|
GetMem(Buffer, BufferSize);
|
||
|
|
try
|
||
|
|
ReadCount := BufferSize;
|
||
|
|
while ReadCount = BufferSize do
|
||
|
|
begin
|
||
|
|
ReadCount := ModuleReader.GetText(ContentPos, Buffer, ReadCount);
|
||
|
|
if ReadCount > 0 then
|
||
|
|
begin
|
||
|
|
Inc(ContentPos, BufferSize);
|
||
|
|
S.Write(Buffer^, ReadCount);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
FreeMem(Buffer);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
{$ENDIF ~BDS}
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure JumpToCode(AStackViewItem: IJclLocationInfo);
|
||
|
|
var
|
||
|
|
S, FileName, ProjectName: string;
|
||
|
|
Module: IOTAModule;
|
||
|
|
ModuleInfo: IOTAModuleInfo;
|
||
|
|
|
||
|
|
SourceEditor: IOTASourceEditor;
|
||
|
|
I, LineNumber: Integer;
|
||
|
|
EditPos: TOTAEditPos;
|
||
|
|
PreparedLocationInfo: IJclPreparedLocationInfo;
|
||
|
|
begin
|
||
|
|
if Assigned(AStackViewItem) then
|
||
|
|
begin
|
||
|
|
if AStackViewItem.QueryInterface(IJclPreparedLocationInfo, PreparedLocationInfo) <> S_OK then
|
||
|
|
PreparedLocationInfo := nil;
|
||
|
|
FileName := AStackViewItem.SourceName;
|
||
|
|
ModuleInfo := FindModuleInfoAndProject(FileName, ProjectName);
|
||
|
|
if Assigned(ModuleInfo) then
|
||
|
|
begin
|
||
|
|
S := ModuleInfo.FileName;
|
||
|
|
if (S <> '') and Assigned(BorlandIDEServices) then
|
||
|
|
begin
|
||
|
|
{$IFDEF BDS}
|
||
|
|
Module := (BorlandIDEServices as IOTAModuleServices).OpenModule(S);
|
||
|
|
{$ELSE ~BDS}
|
||
|
|
Module := ModuleInfo.OpenModule;
|
||
|
|
{$ENDIF ~BDS}
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
if Assigned(PreparedLocationInfo) and PreparedLocationInfo.FoundFile then
|
||
|
|
begin
|
||
|
|
{$IFDEF BDS}
|
||
|
|
Module := (BorlandIDEServices as IOTAModuleServices).OpenModule(PreparedLocationInfo.FileName);
|
||
|
|
{$ELSE ~BDS}
|
||
|
|
(BorlandIDEServices as IOTAActionServices).OpenFile(PreparedLocationInfo.FileName);
|
||
|
|
Module := (BorlandIDEServices as IOTAModuleServices).FindModule(PreparedLocationInfo.FileName);
|
||
|
|
{$ENDIF ~BDS}
|
||
|
|
end;
|
||
|
|
if Assigned(Module) then
|
||
|
|
begin
|
||
|
|
{$IFDEF BDS}
|
||
|
|
Module.Show;
|
||
|
|
{$ENDIF BDS}
|
||
|
|
for I := 0 to Module.GetModuleFileCount - 1 do
|
||
|
|
if Supports(Module.GetModuleFileEditor(I), IOTASourceEditor, SourceEditor) then
|
||
|
|
begin
|
||
|
|
SourceEditor.Show;
|
||
|
|
if SourceEditor.EditViewCount > 0 then
|
||
|
|
begin
|
||
|
|
if Assigned(PreparedLocationInfo) and (PreparedLocationInfo.TranslatedLineNumber > 0) then
|
||
|
|
LineNumber := PreparedLocationInfo.TranslatedLineNumber
|
||
|
|
else
|
||
|
|
LineNumber := AStackViewItem.LineNumber;
|
||
|
|
if LineNumber > 0 then
|
||
|
|
begin
|
||
|
|
SourceEditor.EditViews[0].Center(LineNumber, 1);
|
||
|
|
EditPos.Line := LineNumber;
|
||
|
|
EditPos.Col := 1;
|
||
|
|
SourceEditor.EditViews[0].CursorPos := EditPos;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$IFDEF UNITVERSIONING}
|
||
|
|
initialization
|
||
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
||
|
|
|
||
|
|
finalization
|
||
|
|
UnregisterUnitVersion(HInstance);
|
||
|
|
{$ENDIF UNITVERSIONING}
|
||
|
|
|
||
|
|
end.
|