paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-30 23:42:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: src edit hint: jump to source

Browse Source 
git-svn-id: trunk@31187 -
This commit is contained in:
mattias 2011-06-12 22:11:46 +00:00
parent ddc247b49e
commit 78bb459fc6
2 changed files with 81 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
components/turbopower_ipro/design/ipidehtmlcontrol.pas
View File

@ -22,8 +22,8 @@ unit IPIDEHTMLControl;
interface
uses
Classes, SysUtils, LCLProc, Graphics, Controls, Dialogs, ExtCtrls,
IpMsg, Ipfilebroker, IpHtml, IDEHelpIntf, LazHelpIntf;
Classes, SysUtils, LCLProc, Forms, Graphics, Controls, Dialogs, ExtCtrls,
IpMsg, Ipfilebroker, IpHtml, IDEHelpIntf, LazHelpIntf, LazIDEIntf, TextTools;
type
TLazIPHtmlControl = class;
@ -51,6 +51,7 @@ type
var Picture: TPicture);
procedure DataProviderLeave(Sender: TIpHtml);
procedure DataProviderReportReference(Sender: TObject; const URL: string);
procedure IPHTMLPanelHotClick(Sender: TObject);
private
FIDEProvider: TAbstractIDEHTMLProvider;
FIPHTMLPanel: TIpHtmlPanel;
@ -70,6 +71,17 @@ type
property IPHTMLPanel: TIpHtmlPanel read FIPHTMLPanel;
end;
{ TLazIPHTMLManager }
TLazIPHTMLManager = class
public
NextURL: string;
procedure OpenNextURL(Data: PtrInt); // called via Application.QueueAsyncCall
end;
var
LazIPHTMLManager: TLazIPHTMLManager = nil;
function IPCreateLazIDEHTMLControl(Owner: TComponent;
var Provider: TAbstractIDEHTMLProvider): TControl;
@ -96,6 +108,30 @@ begin
HTMLControl.IDEProvider:=Provider;
end;
{ TLazIPHTMLManager }
procedure TLazIPHTMLManager.OpenNextURL(Data: PtrInt);
var
URLScheme: string;
URLPath: string;
URLParams: string;
AFilename: String;
p: TPoint;
begin
SplitURL(NextURL,URLScheme,URLPath,URLParams);
if URLScheme='source' then begin
p:=Point(1,1);
if REMatches(URLPath,'(.*)\((.*),(.*)\)') then begin
AFilename:=REVar(1);
p.Y:=StrToIntDef(REVar(2),p.x);
p.X:=StrToIntDef(REVar(3),p.y);
end else begin
AFilename:=URLPath;
end;
LazarusIDE.DoOpenFileAndJumpToPos(AFilename,p,-1,-1,-1,[]);
end;
end;
{ TLazIpHtmlDataProvider }
function TLazIpHtmlDataProvider.DoGetStream(const URL: string): TStream;
@ -184,6 +220,35 @@ begin
debugln(['TLazIPHtmlControl.DataProviderReportReference URL=',URL]);
end;
procedure TLazIPHtmlControl.IPHTMLPanelHotClick(Sender: TObject);
var
HotNode: TIpHtmlNode;
HRef: String;
Target: String;
URLScheme: string;
URLPath: string;
URLParams: string;
begin
HotNode:=FIPHTMLPanel.HotNode;
if HotNode is TIpHtmlNodeA then begin
HRef := TIpHtmlNodeA(HotNode).HRef;
Target := TIpHtmlNodeA(HotNode).Target;
end else begin
HRef := TIpHtmlNodeAREA(HotNode).HRef;
Target := TIpHtmlNodeAREA(HotNode).Target;
end;
debugln(['TLazIPHtmlControl.IPHTMLPanelHotClick HRef="',HRef,'" Target="',Target,'"']);
SplitURL(HRef,URLScheme,URLPath,URLParams);
if URLScheme='source' then begin
// open the source in the IDE
// This will close the hint, so the open must be done outside the current event
if LazIPHTMLManager=nil then
LazIPHTMLManager:=TLazIPHTMLManager.Create;
LazIPHTMLManager.NextURL:=HRef;
Application.QueueAsyncCall(@LazIPHTMLManager.OpenNextURL,0);
end;
end;
procedure TLazIPHtmlControl.SetIDEProvider(
const AValue: TAbstractIDEHTMLProvider);
begin
@ -223,6 +288,7 @@ begin
MarginHeight:=2;
MarginWidth:=2;
Parent:=Self;
OnHotClick:=@IPHTMLPanelHotClick;
end;
FIPHTMLPanel.DataProvider:=TLazIpHtmlDataProvider.Create(FIPHTMLPanel);
with TLazIpHtmlDataProvider(FIPHTMLPanel.DataProvider) do begin
@ -316,9 +382,14 @@ end;
procedure TLazIPHtmlControl.GetPreferredControlSize(out AWidth, AHeight: integer);
begin
AWidth:=0;
AHeight:=0;
inherited GetPreferredSize(AWidth, AHeight);
//debugln(['TLazIPHtmlControl.GetPreferredControlSize Width=',AWidth,' Height=',AHeight]);
end;
finalization
FreeAndNil(LazIPHTMLManager);
end.

16
lcl/lazhelpintf.pas
View File

@ -578,8 +578,8 @@ procedure FreeUnusedLCLHelpSystem;
function FilenameToURL(const Filename: string): string;
function FilenameToURLPath(const Filename: string): string;
function URLPathToFilename(const URLPath: string): string;
procedure SplitURL(const URL: string; out URLType, URLPath, URLParams: string);
function CombineURL(const URLType, URLPath, URLParams: string): string;
procedure SplitURL(const URL: string; out URLScheme, URLPath, URLParams: string);
function CombineURL(const URLScheme, URLPath, URLParams: string): string;
function URLFilenameIsAbsolute(const URLPath: string): boolean;
function FindURLPathStart(const URL: string): integer;
function FindURLPathEnd(const URL: string): integer;
@ -656,14 +656,14 @@ begin
{$warnings on}
end;
procedure SplitURL(const URL: string; out URLType, URLPath, URLParams: string);
procedure SplitURL(const URL: string; out URLScheme, URLPath, URLParams: string);
var
Len: Integer;
ColonPos: Integer;
ParamStartPos: integer;
URLStartPos: Integer;
begin
URLType:='';
URLScheme:='';
URLPath:='';
URLParams:='';
Len:=length(URL);
@ -672,8 +672,8 @@ begin
while (ColonPos<=len) and (URL[ColonPos]<>':') do
inc(ColonPos);
if ColonPos>len then exit;
// get URLType
URLType:=copy(URL,1,ColonPos-1);
// get URLScheme
URLScheme:=copy(URL,1,ColonPos-1);
URLStartPos:=ColonPos+1;
// skip the '//' after the colon
if (URLStartPos<=len) and (URL[URLStartPos]='/') then inc(URLStartPos);
@ -687,9 +687,9 @@ begin
URLParams:=copy(URL,ParamStartPos,len-ParamStartPos+1);
end;
function CombineURL(const URLType, URLPath, URLParams: string): string;
function CombineURL(const URLScheme, URLPath, URLParams: string): string;
begin
Result:=URLType+'://'+URLPath;
Result:=URLScheme+'://'+URLPath;
if URLParams<>'' then
Result:=Result+URLParams;
end;