mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-03 23:59:32 +01:00
450 lines
14 KiB
ObjectPascal
450 lines
14 KiB
ObjectPascal
{ $Id: helpintf.pas 9271 2006-05-13 12:00:43Z mattias $ }
|
|
{
|
|
*****************************************************************************
|
|
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
|
for details about the license.
|
|
*****************************************************************************
|
|
|
|
Author: Mattias Gaertner
|
|
|
|
Abstract:
|
|
This unit defines various base classes for the Help System used by the IDE.
|
|
}
|
|
unit IDEHelpIntf;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, types, LCLProc, Forms, Controls, HelpIntfs, LazHelpIntf,
|
|
LMessages, LCLType, TextTools;
|
|
|
|
type
|
|
{ THelpDBIRegExprMessage
|
|
Help registration item for matching a message (e.g. a fpc warning) with
|
|
a regular expression.
|
|
For example a line like
|
|
"/usr/share/lazarus/components/synedit/syneditkeycmds.pp(532,10) Warning: Function result does not seem to be set"
|
|
could be matched with
|
|
Expression=') Warning: Function result does not seem to be set'
|
|
}
|
|
|
|
THelpDBIRegExprMessage = class(THelpDBIMessage)
|
|
private
|
|
FExpression: string;
|
|
FModifierStr: string;
|
|
public
|
|
constructor Create(TheNode: THelpNode; const RegularExpression,
|
|
TheModifierStr: string);
|
|
function MessageMatches(const TheMessage: string; {%H-}MessageParts: TStrings
|
|
): boolean; override;
|
|
property Expression: string read FExpression write FExpression;
|
|
property ModifierStr: string read FModifierStr write FModifierStr;
|
|
end;
|
|
|
|
TIDEHelpManagerCreateHintFlag = (
|
|
ihmchAddFocusHint
|
|
);
|
|
TIDEHelpManagerCreateHintFlags = set of TIDEHelpManagerCreateHintFlag;
|
|
|
|
{ TBaseHelpManager }
|
|
|
|
TBaseHelpManager = class(TComponent)
|
|
public
|
|
procedure ConnectMainBarEvents; virtual; abstract;
|
|
procedure LoadHelpOptions; virtual; abstract;
|
|
procedure SaveHelpOptions; virtual; abstract;
|
|
|
|
function ShowHelpForSourcePosition(const Filename: string;
|
|
const CodePos: TPoint;
|
|
var ErrMsg: string): TShowHelpResult; virtual; abstract;
|
|
procedure ShowHelpForMessage; virtual; abstract;
|
|
procedure ShowHelpForObjectInspector(Sender: TObject); virtual; abstract;
|
|
procedure ShowHelpForIDEControl(Sender: TControl); virtual; abstract;
|
|
function CreateHint(aHintWindow: THintWindow; ScreenPos: TPoint;
|
|
const BaseURL: string; var TheHint: string; out HintWinRect: TRect): boolean;
|
|
virtual; abstract; deprecated 'Use THintWindowManager class instead';
|
|
function GetHintForSourcePosition(const ExpandedFilename: string;
|
|
const CodePos: TPoint; out BaseURL, HTMLHint: string;
|
|
Flags: TIDEHelpManagerCreateHintFlags = []): TShowHelpResult; virtual; abstract;
|
|
function ConvertSourcePosToPascalHelpContext(const CaretPos: TPoint;
|
|
const Filename: string): TPascalHelpContextList; virtual; abstract;
|
|
// fpdoc
|
|
function GetFPDocFilenameForSource(SrcFilename: string;
|
|
ResolveIncludeFiles: Boolean;
|
|
out AnOwner: TObject// a package or a project or LazarusHelp or nil for user defined
|
|
): string; virtual; abstract;
|
|
end;
|
|
|
|
|
|
var
|
|
LazarusHelp: TBaseHelpManager; // initialized by the IDE
|
|
FPCMessagesHelpDB: THelpDatabase; // initialized by the IDE
|
|
|
|
type
|
|
{ TIDEHTMLControlIntf }
|
|
|
|
TIDEHTMLControlIntf = interface
|
|
function GetURL: string;
|
|
procedure SetURL(const AValue: string);
|
|
property URL: string read GetURL write SetURL;
|
|
procedure SetHTMLContent(Stream: TStream; const NewURL: string = '');
|
|
procedure GetPreferredControlSize(out AWidth, AHeight: integer);
|
|
end;
|
|
|
|
{ TAbstractIDEHTMLProvider
|
|
An instance of this class connects 3 parts:
|
|
1. IDE html files (via implementation)
|
|
2. a html viewer control (via ControlIntf)
|
|
3. IDE or designtime package code
|
|
All three can communicate. }
|
|
|
|
TAbstractIDEHTMLProvider = class(TComponent)
|
|
protected
|
|
FBaseURL: string;
|
|
FControlIntf: TIDEHTMLControlIntf;
|
|
procedure SetBaseURL(const AValue: string); virtual;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function URLHasStream(const URL: string): boolean; virtual; abstract;
|
|
{ Open a URL asynchronously
|
|
The standard IDE implementation supports the following for OpenURLAsync:
|
|
source://local-file-name : open a file local-file-name in the source editor
|
|
openpackage://package-name : open a package editor
|
|
fpdoc://#package-name.unitname.element : this opens the help for the fpdoc entry
|
|
}
|
|
procedure OpenURLAsync(const URL: string); virtual; abstract;
|
|
function GetStream(const URL: string; Shared: boolean
|
|
): TStream; virtual; abstract; { Shared=true: provider assumes ownership
|
|
of returned TStream and increases internal reference count.
|
|
If not found it raises an exception.
|
|
Shared=false: caller must free stream}
|
|
procedure ReleaseStream(const URL: string); virtual; abstract;
|
|
property BaseURL: string read FBaseURL write SetBaseURL;// fallback for relative URLs
|
|
function MakeURLAbsolute(const aBaseURL, aURL: string): string; virtual;
|
|
property ControlIntf: TIDEHTMLControlIntf read FControlIntf write FControlIntf;
|
|
end;
|
|
|
|
TIDEHTMLControlFlag = (
|
|
ihcScrollable,
|
|
ihcWithClipboardMenu
|
|
);
|
|
TIDEHTMLControlFlags = set of TIDEHTMLControlFlag;
|
|
|
|
TCreateIDEHTMLControlEvent =
|
|
function(Owner: TComponent; var Provider: TAbstractIDEHTMLProvider;
|
|
Flags: TIDEHTMLControlFlags = []): TControl;
|
|
TCreateIDEHTMLProviderEvent =
|
|
function(Owner: TComponent): TAbstractIDEHTMLProvider;
|
|
|
|
|
|
{ TSolidHintWindowRendered }
|
|
|
|
TSolidHintWindowRendered = class(THintWindowRendered)
|
|
protected
|
|
procedure WMNCHitTest(var Message: TLMessage); message LM_NCHITTEST;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
end;
|
|
|
|
{ THintWindowManager }
|
|
|
|
THintWindowManager = class
|
|
private
|
|
// 2 HintWindows, one for simple text and one for rendered hint with child control.
|
|
// Only one is visible at a time.
|
|
FHintTextW: THintWindow;
|
|
FHintRenderW: THintWindowRendered;
|
|
FCurrentHintW: THintWindow; // One of the windows or Nil.
|
|
// Provider for the rendered hint.
|
|
FHtmlHelpProvider: TAbstractIDEHTMLProvider;
|
|
FBaseURL: string;
|
|
FFlags: TIDEHTMLControlFlags;
|
|
FOrigMousePos: TPoint;
|
|
// These will be passed to HintWindow.
|
|
FAutoHide: Boolean;
|
|
FHideInterval: Integer;
|
|
FOnMouseDown: TMouseEvent;
|
|
FWindowName: string;
|
|
function HtmlHelpProvider: TAbstractIDEHTMLProvider;
|
|
function HintTextWindow: THintWindow;
|
|
function HintRenderWindow: THintWindowRendered;
|
|
procedure SetAutoHide(AValue: Boolean);
|
|
procedure SetHideInterval(AValue: Integer);
|
|
procedure SetOnMouseDown(AValue: TMouseEvent);
|
|
procedure SetWindowName(AValue: string);
|
|
protected
|
|
public
|
|
constructor Create; overload;
|
|
destructor Destroy; override;
|
|
function HintIsVisible: boolean;
|
|
function ShowHint(ScreenPos: TPoint; TheHint: string): boolean;
|
|
procedure HideHint;
|
|
procedure HideIfVisible;
|
|
public
|
|
property CurHintWindow: THintWindow read FCurrentHintW;
|
|
property BaseURL: string read FBaseURL write FBaseURL;
|
|
property Flags: TIDEHTMLControlFlags read FFlags write FFlags;
|
|
property AutoHide: Boolean read FAutoHide write SetAutoHide;
|
|
property HideInterval: Integer read FHideInterval write SetHideInterval;
|
|
property OnMouseDown: TMouseEvent read FOnMouseDown write SetOnMouseDown;
|
|
property WindowName: string read FWindowName write SetWindowName;
|
|
end;
|
|
|
|
var
|
|
CreateIDEHTMLControl: TCreateIDEHTMLControlEvent = nil;// will be set by the IDE
|
|
// and can be overidden by a package like turbopoweriprodsgn.lpk
|
|
CreateIDEHTMLProvider: TCreateIDEHTMLProviderEvent = nil;// will be set by the IDE
|
|
|
|
FPCKeyWordHelpPrefix: string = 'FPCKeyword_';
|
|
FPCDirectiveHelpPrefix: string = 'FPCDirective_';
|
|
IDEDirectiveHelpPrefix: string = 'IDEDirective_';
|
|
|
|
implementation
|
|
|
|
{ TSolidHintWindowRendered }
|
|
|
|
procedure TSolidHintWindowRendered.WMNCHitTest(var Message: TLMessage);
|
|
begin
|
|
Message.Result := HTCLIENT;
|
|
end;
|
|
|
|
procedure TSolidHintWindowRendered.KeyDown(var Key: Word; Shift: TShiftState);
|
|
Var
|
|
AOldKey : Word;
|
|
begin
|
|
AOldKey := Key;
|
|
inherited KeyDown(Key, Shift);
|
|
if AOldKey=VK_ESCAPE then
|
|
Hide;
|
|
end;
|
|
|
|
constructor TSolidHintWindowRendered.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
KeyPreview := True;
|
|
end;
|
|
|
|
{ THelpDBIRegExprMessage }
|
|
|
|
constructor THelpDBIRegExprMessage.Create(TheNode: THelpNode;
|
|
const RegularExpression, TheModifierStr: string);
|
|
begin
|
|
Node:=TheNode;
|
|
FExpression:=RegularExpression;
|
|
FModifierStr:=TheModifierStr;
|
|
end;
|
|
|
|
function THelpDBIRegExprMessage.MessageMatches(const TheMessage: string;
|
|
MessageParts: TStrings): boolean;
|
|
begin
|
|
Result:=REMatches(TheMessage,Expression,ModifierStr);
|
|
//writeln('THelpDBIRegExprMessage.MessageMatches TheMessage="',TheMessage,'" Expression="',Expression,'" Result=',Result);
|
|
end;
|
|
|
|
{ TAbstractIDEHTMLProvider }
|
|
|
|
procedure TAbstractIDEHTMLProvider.SetBaseURL(const AValue: string);
|
|
begin
|
|
if FBaseURL=AValue then exit;
|
|
FBaseURL:=AValue;
|
|
end;
|
|
|
|
constructor TAbstractIDEHTMLProvider.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
end;
|
|
|
|
destructor TAbstractIDEHTMLProvider.Destroy;
|
|
begin
|
|
FControlIntf:=nil; // decrease reference count
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TAbstractIDEHTMLProvider.MakeURLAbsolute(const aBaseURL, aURL: string): string;
|
|
var
|
|
URLType: string;
|
|
URLPath: string;
|
|
URLParams: string;
|
|
begin
|
|
Result:=aURL;
|
|
SplitURL(aURL,URLType,URLPath,URLParams);
|
|
//DebugLn(['TAbstractIDEHTMLProvider.BuildURL URL=',aURL,' URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams]);
|
|
if URLType='' then begin
|
|
// no URLType => use aURL as URLPath
|
|
Result:=aURL;
|
|
if not URLFilenameIsAbsolute(Result) then begin
|
|
if aBaseURL<>'' then
|
|
Result:=aBaseURL+Result
|
|
else
|
|
Result:=BaseURL+Result;
|
|
end;
|
|
end else begin
|
|
Result:=aURL;
|
|
end;
|
|
end;
|
|
|
|
{ THintWindowManager }
|
|
|
|
constructor THintWindowManager.Create;
|
|
begin
|
|
inherited Create;
|
|
FFlags := [ihcWithClipboardMenu];
|
|
FHideInterval := 3000;
|
|
end;
|
|
|
|
destructor THintWindowManager.Destroy;
|
|
begin
|
|
FreeAndNil(FHintRenderW);
|
|
FreeAndNil(FHintTextW);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function THintWindowManager.HintTextWindow: THintWindow;
|
|
begin
|
|
if FHintTextW = nil then
|
|
begin
|
|
FHintTextW := THintWindow.Create(Nil);
|
|
FHintTextW.AutoHide := FAutoHide;
|
|
FHintTextW.HideInterval := FHideInterval;
|
|
FHintTextW.OnMouseDown := FOnMouseDown;
|
|
if FWindowName <> '' then
|
|
FHintTextW.Name := FWindowName;
|
|
end;
|
|
FCurrentHintW := FHintTextW;
|
|
Result := FHintTextW;
|
|
end;
|
|
|
|
function THintWindowManager.HintRenderWindow: THintWindowRendered;
|
|
begin
|
|
if FHintRenderW = nil then
|
|
begin
|
|
FHintRenderW := TSolidHintWindowRendered.Create(Nil);
|
|
FHintRenderW.AutoHide := FAutoHide;
|
|
FHintRenderW.HideInterval := FHideInterval;
|
|
FHintRenderW.OnMouseDown := FOnMouseDown;
|
|
if FWindowName <> '' then
|
|
FHintRenderW.Name := FWindowName;
|
|
end;
|
|
FCurrentHintW := FHintRenderW;
|
|
Result := FHintRenderW;
|
|
end;
|
|
|
|
function THintWindowManager.HintIsVisible: boolean;
|
|
begin
|
|
Result := Assigned(FCurrentHintW) and FCurrentHintW.Visible;
|
|
end;
|
|
|
|
function THintWindowManager.HtmlHelpProvider: TAbstractIDEHTMLProvider;
|
|
var
|
|
HelpControl: TControl;
|
|
begin
|
|
if FHtmlHelpProvider = nil then
|
|
begin
|
|
//Include(FFlags, ihcScrollable); // Debug (memo hint control does not work)
|
|
HelpControl := CreateIDEHTMLControl(HintRenderWindow, FHtmlHelpProvider, FFlags);
|
|
HelpControl.Parent := HintRenderWindow;
|
|
HelpControl.Align := alClient;
|
|
end;
|
|
Result := FHtmlHelpProvider;
|
|
end;
|
|
|
|
function THintWindowManager.ShowHint(ScreenPos: TPoint; TheHint: string): boolean;
|
|
var
|
|
ms: TMemoryStream;
|
|
NewWidth, NewHeight: integer;
|
|
|
|
procedure DoText;
|
|
var
|
|
HintWinRect: TRect;
|
|
begin
|
|
HintWinRect := HintTextWindow.CalcHintRect(Screen.Width, TheHint, Nil);
|
|
HintTextWindow.HintRect := HintWinRect; // Adds borders.
|
|
HintTextWindow.OffsetHintRect(ScreenPos);
|
|
HintTextWindow.ActivateHint(TheHint);
|
|
end;
|
|
|
|
procedure DoHtml;
|
|
begin
|
|
HtmlHelpProvider.BaseURL:=FBaseURL;
|
|
ms:=TMemoryStream.Create;
|
|
try
|
|
if TheHint<>'' then
|
|
ms.Write(TheHint[1],length(TheHint));
|
|
ms.Position:=0;
|
|
HtmlHelpProvider.ControlIntf.SetHTMLContent(ms,'');
|
|
finally
|
|
ms.Free;
|
|
end;
|
|
HtmlHelpProvider.ControlIntf.GetPreferredControlSize(NewWidth,NewHeight);
|
|
if NewWidth <= 0 then
|
|
NewWidth := 500;
|
|
if NewHeight <= 0 then
|
|
NewHeight := 200;
|
|
HintRenderWindow.HintRectAdjust := Rect(0, 0, NewWidth, NewHeight);
|
|
HintRenderWindow.OffsetHintRect(ScreenPos);
|
|
HintRenderWindow.ActivateRendered;
|
|
end;
|
|
|
|
begin
|
|
if TheHint = '' then Exit(False);
|
|
FOrigMousePos := Mouse.CursorPos;
|
|
if FHintTextW <> nil then
|
|
FHintTextW.Visible := false;
|
|
if FHintRenderW <> nil then
|
|
FHintRenderW.Visible := false;
|
|
if CompareText(copy(TheHint,1,6),'<HTML>')=0 then // Text is HTML
|
|
DoHtml
|
|
else // Plain text
|
|
DoText;
|
|
Result:=True;
|
|
end;
|
|
|
|
procedure THintWindowManager.HideHint;
|
|
begin
|
|
if Assigned(FCurrentHintW) then
|
|
FCurrentHintW.Visible := False;
|
|
end;
|
|
|
|
procedure THintWindowManager.HideIfVisible;
|
|
begin
|
|
if HintIsVisible then
|
|
FCurrentHintW.Visible := False;
|
|
end;
|
|
|
|
// Setters
|
|
|
|
procedure THintWindowManager.SetAutoHide(AValue: Boolean);
|
|
begin
|
|
FAutoHide := AValue;
|
|
if Assigned(FHintTextW) then FHintTextW.AutoHide := FAutoHide;
|
|
if Assigned(FHintRenderW) then FHintRenderW.AutoHide := FAutoHide;
|
|
end;
|
|
|
|
procedure THintWindowManager.SetHideInterval(AValue: Integer);
|
|
begin
|
|
FHideInterval := AValue;
|
|
if Assigned(FHintTextW) then FHintTextW.HideInterval := FHideInterval;
|
|
if Assigned(FHintRenderW) then FHintRenderW.HideInterval := FHideInterval;
|
|
end;
|
|
|
|
procedure THintWindowManager.SetOnMouseDown(AValue: TMouseEvent);
|
|
begin
|
|
FOnMouseDown:=AValue;
|
|
if Assigned(FHintTextW) then FHintTextW.OnMouseDown := FOnMouseDown;
|
|
if Assigned(FHintRenderW) then FHintRenderW.OnMouseDown := FOnMouseDown;
|
|
end;
|
|
|
|
procedure THintWindowManager.SetWindowName(AValue: string);
|
|
begin
|
|
FWindowName := AValue;
|
|
if Assigned(FHintTextW) then FHintTextW.Name := FWindowName;
|
|
if Assigned(FHintRenderW) then FHintRenderW.Name := FWindowName;
|
|
end;
|
|
|
|
end.
|
|
|