mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-13 00:49:23 +02:00
1346 lines
42 KiB
ObjectPascal
1346 lines
42 KiB
ObjectPascal
{ $Id$ }
|
|
{
|
|
/***************************************************************************
|
|
helpmanager.pas
|
|
---------------
|
|
|
|
|
|
***************************************************************************/
|
|
|
|
***************************************************************************
|
|
* *
|
|
* 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
|
* *
|
|
***************************************************************************
|
|
}
|
|
unit HelpManager;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
// FCL+LCL
|
|
Classes, SysUtils, AVL_Tree, LCLProc, LCLIntf, LCLType, Forms, Controls, Buttons,
|
|
StdCtrls, Dialogs, ExtCtrls, FileUtil, Graphics,
|
|
// CodeTools
|
|
BasicCodeTools, CodeToolManager, CodeAtom, CodeCache, CustomCodeTool, CodeTree,
|
|
PascalParserTool, FindDeclarationTool,
|
|
// IDEIntf
|
|
PropEdits, ObjectInspector, FormEditingIntf, ProjectIntf,
|
|
LazHelpIntf, LazHelpHTML, HelpFPDoc, MacroIntf, IDEWindowIntf, IDEMsgIntf,
|
|
LazIDEIntf, HelpIntfs, IDEHelpIntf,
|
|
// IDE
|
|
LazarusIDEStrConsts, TransferMacros, DialogProcs, IDEOptionDefs,
|
|
ObjInspExt, EnvironmentOpts, AboutFrm, MsgView, Project, PackageDefs, MainBar,
|
|
OutputFilter, HelpOptions, MainIntf, LazConf, HelpFPCMessages, CodeHelp,
|
|
IDEContextHelpEdit, ButtonPanel;
|
|
|
|
type
|
|
|
|
TLIHProviders = class;
|
|
|
|
{ TLazIDEHTMLProvider }
|
|
|
|
TLazIDEHTMLProvider = class(TAbstractIDEHTMLProvider)
|
|
private
|
|
FProviders: TLIHProviders;
|
|
procedure SetProviders(const AValue: TLIHProviders);
|
|
public
|
|
function GetStream(const URL: string): TStream; override;
|
|
procedure ReleaseStream(const URL: string); override;
|
|
property Providers: TLIHProviders read FProviders write SetProviders;
|
|
end;
|
|
|
|
{ TLIHProviderStream }
|
|
|
|
TLIHProviderStream = class
|
|
private
|
|
FRefCount: integer;
|
|
public
|
|
Stream: TStream;
|
|
URL: string;
|
|
destructor Destroy; override;
|
|
procedure IncreaseRefCount;
|
|
procedure DecreaseRefCount;
|
|
property RefCount: integer read FRefCount;
|
|
end;
|
|
|
|
{ TLIHProviders
|
|
manages all TLazIDEHTMLProvider }
|
|
|
|
TLIHProviders = class
|
|
private
|
|
FStreams: TAVLTree;// tree of TLIHProviderStream sorted for URL
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function FindStream(const URL: string; CreateIfNotExists: Boolean): TLIHProviderStream;
|
|
function GetStream(const URL: string): TStream;
|
|
procedure ReleaseStream(const URL: string);
|
|
end;
|
|
|
|
{ TSimpleHTMLControl }
|
|
|
|
TSimpleHTMLControl = class(TLabel,TIDEHTMLControlIntf)
|
|
private
|
|
FProvider: TAbstractIDEHTMLProvider;
|
|
FURL: string;
|
|
procedure SetProvider(const AValue: TAbstractIDEHTMLProvider);
|
|
function HTMLToCaption(const s: string): string;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
function GetURL: string;
|
|
procedure SetURL(const AValue: string);
|
|
property Provider: TAbstractIDEHTMLProvider read FProvider write SetProvider;
|
|
procedure SetHTMLContent(Stream: TStream);
|
|
procedure GetPreferredControlSize(out AWidth, AHeight: integer);
|
|
end;
|
|
|
|
{ TIDEHelpDatabases }
|
|
|
|
TIDEHelpDatabases = class(THelpDatabases)
|
|
public
|
|
function ShowHelpSelector(Query: THelpQuery; Nodes: THelpNodeQueryList;
|
|
var ErrMsg: string;
|
|
var Selection: THelpNodeQuery
|
|
): TShowHelpResult; override;
|
|
function GetBaseDirectoryForBasePathObject(BasePathObject: TObject): string; override;
|
|
function ShowHelpForSourcePosition(Query: THelpQuerySourcePosition;
|
|
var ErrMsg: string): TShowHelpResult; override;
|
|
function SubstituteMacros(var s: string): boolean; override;
|
|
end;
|
|
|
|
|
|
{ TIDEHelpManager }
|
|
|
|
TIDEHelpManager = class(TBaseHelpManager)
|
|
// help menu of the IDE menu bar
|
|
procedure mnuHelpAboutLazarusClicked(Sender: TObject);
|
|
procedure mnuHelpOnlineHelpClicked(Sender: TObject);
|
|
procedure mnuHelpReportBugClicked(Sender: TObject);
|
|
private
|
|
FFCLHelpDBPath: THelpBaseURLObject;
|
|
FLCLHelpDBPath: THelpBaseURLObject;
|
|
FMainHelpDB: THelpDatabase;
|
|
FMainHelpDBPath: THelpBasePathObject;
|
|
FRTLHelpDB: THelpDatabase;
|
|
FFCLHelpDB: THelpDatabase;
|
|
FLCLHelpDB: THelpDatabase;
|
|
FRTLHelpDBPath: THelpBaseURLObject;
|
|
FHTMLProviders: TLIHProviders;
|
|
procedure RegisterIDEHelpDatabases;
|
|
procedure RegisterDefaultIDEHelpViewers;
|
|
procedure FindDefaultBrowser(var DefaultBrowser, Params: string);
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure UpdateFPCDocsHTMLDirectory;
|
|
|
|
procedure ConnectMainBarEvents; override;
|
|
procedure LoadHelpOptions; override;
|
|
procedure SaveHelpOptions; override;
|
|
|
|
procedure ShowLazarusHelpStartPage;
|
|
procedure ShowIDEHelpForContext(HelpContext: THelpContext);
|
|
procedure ShowIDEHelpForKeyword(const Keyword: string);
|
|
|
|
function ShowHelpForSourcePosition(const Filename: string;
|
|
const CodePos: TPoint;
|
|
var ErrMsg: string): TShowHelpResult; override;
|
|
procedure ShowHelpForMessage(Line: integer); override;
|
|
procedure ShowHelpForObjectInspector(Sender: TObject); override;
|
|
function CreateHint(aHintWindow: THintWindow; ScreenPos: TPoint;
|
|
const BaseURL: string; var TheHint: string;
|
|
out HintWinRect: TRect): boolean; override;
|
|
function GetHintForSourcePosition(const ExpandedFilename: string;
|
|
const CodePos: TPoint;
|
|
out BaseURL, HTMLHint: string): TShowHelpResult; override;
|
|
|
|
function ConvertSourcePosToPascalHelpContext(const CaretPos: TPoint;
|
|
const Filename: string): TPascalHelpContextList; override;
|
|
function ConvertCodePosToPascalHelpContext(
|
|
ACodePos: PCodeXYPosition): TPascalHelpContextList;
|
|
public
|
|
property FCLHelpDB: THelpDatabase read FFCLHelpDB;
|
|
property FCLHelpDBPath: THelpBaseURLObject read FFCLHelpDBPath;
|
|
property LCLHelpDB: THelpDatabase read FLCLHelpDB;
|
|
property LCLHelpDBPath: THelpBaseURLObject read FLCLHelpDBPath;
|
|
property MainHelpDB: THelpDatabase read FMainHelpDB;
|
|
property MainHelpDBPath: THelpBasePathObject read FMainHelpDBPath;
|
|
property RTLHelpDB: THelpDatabase read FRTLHelpDB;
|
|
property RTLHelpDBPath: THelpBaseURLObject read FRTLHelpDBPath;
|
|
end;
|
|
|
|
{ THelpSelectorDialog }
|
|
|
|
THelpSelectorDialog = class(TForm)
|
|
BtnPanel: TButtonPanel;
|
|
NodesGroupBox: TGroupBox;
|
|
NodesListBox: TListBox;
|
|
procedure HelpSelectorDialogClose(Sender: TObject;
|
|
var CloseAction: TCloseAction);
|
|
procedure NodesListBoxDblClick(Sender: TObject);
|
|
private
|
|
FNodes: THelpNodeQueryList;
|
|
procedure SetNodes(const AValue: THelpNodeQueryList);
|
|
procedure FillNodesListBox;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
property Nodes: THelpNodeQueryList read FNodes write SetNodes;
|
|
end;
|
|
|
|
{ Help Contexts for IDE help }
|
|
const
|
|
lihcStartPage = 'StartPage';
|
|
lihcRTLUnits = 'RTLUnits';
|
|
lihcFCLUnits = 'FCLUnits';
|
|
lihcLCLUnits = 'LCLUnits';
|
|
|
|
lihBaseUrl = 'http://lazarus-ccr.sourceforge.net/docs/';
|
|
|
|
lihRTLURL = lihBaseUrl+'rtl/';
|
|
lihFCLURL = lihBaseUrl+'fcl/';
|
|
lihLCLURL = lihBaseUrl+'lcl/';
|
|
|
|
var
|
|
HelpBoss: TBaseHelpManager = nil;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
function LazCreateIDEHTMLControl(Owner: TComponent;
|
|
var Provider: TAbstractIDEHTMLProvider): TControl;
|
|
var
|
|
HTMLControl: TSimpleHTMLControl;
|
|
begin
|
|
HTMLControl:=TSimpleHTMLControl.Create(Owner);
|
|
Result:=HTMLControl;
|
|
if Provider=nil then
|
|
Provider:=CreateIDEHTMLProvider(HTMLControl);
|
|
Provider.ControlIntf:=HTMLControl;
|
|
HTMLControl.Provider:=Provider;
|
|
end;
|
|
|
|
function LazCreateIDEHTMLProvider(Owner: TComponent): TAbstractIDEHTMLProvider;
|
|
begin
|
|
Result:=TLazIDEHTMLProvider.Create(Owner);
|
|
TLazIDEHTMLProvider(Result).Providers:=TIDEHelpManager(HelpBoss).FHTMLProviders;
|
|
end;
|
|
|
|
function CompareLIHProviderStream(Data1, Data2: Pointer): integer;
|
|
begin
|
|
Result:=CompareStr(TLIHProviderStream(Data1).URL,TLIHProviderStream(Data2).URL);
|
|
end;
|
|
|
|
function CompareURLWithLIHProviderStream(URL, Stream: Pointer): integer;
|
|
begin
|
|
Result:=CompareStr(AnsiString(URL),TLIHProviderStream(Stream).URL);
|
|
end;
|
|
|
|
{ TSimpleHTMLControl }
|
|
|
|
procedure TSimpleHTMLControl.SetProvider(const AValue: TAbstractIDEHTMLProvider
|
|
);
|
|
begin
|
|
if FProvider=AValue then exit;
|
|
FProvider:=AValue;
|
|
end;
|
|
|
|
function TSimpleHTMLControl.HTMLToCaption(const s: string): string;
|
|
var
|
|
p: Integer;
|
|
EndPos: Integer;
|
|
CurTag: String;
|
|
NewTag: String;
|
|
begin
|
|
Result:=s;
|
|
p:=1;
|
|
while p<=length(Result) do begin
|
|
if Result[p]='<' then begin
|
|
// skip html tag
|
|
EndPos:=p+1;
|
|
while (EndPos<=length(Result)) do begin
|
|
if Result[EndPos]='"' then begin
|
|
// skip " tag
|
|
while (EndPos<=length(Result)) and (Result[EndPos]<>'"') do
|
|
inc(EndPos);
|
|
if EndPos>length(Result) then break;
|
|
end;
|
|
if (Result[EndPos]='>') then begin
|
|
inc(EndPos);
|
|
break;
|
|
end;
|
|
inc(EndPos);
|
|
end;
|
|
CurTag:=copy(Result,p,EndPos-p);
|
|
if SysUtils.CompareText(CurTag,'<BR>')=0 then
|
|
NewTag:=LineEnding
|
|
else
|
|
NewTag:='';
|
|
if NewTag='' then
|
|
System.Delete(Result,p,EndPos-p)
|
|
else begin
|
|
Result:=copy(Result,1,p-1)+NewTag+copy(Result,EndPos,length(Result));
|
|
inc(p,length(NewTag));
|
|
end;
|
|
end else if Result[p] in [' ',#9,#10,#13] then begin
|
|
// replace spaces and newline characters with a single space
|
|
EndPos:=p+1;
|
|
while (EndPos<=length(Result)) and (Result[EndPos] in [' ',#9,#10,#13]) do
|
|
inc(EndPos);
|
|
if (p > 1) and not (Result[p-1] in [' ',#9,#10,#13]) then
|
|
begin
|
|
Result:=copy(Result,1,p-1)+' '+copy(Result,EndPos,length(Result));
|
|
inc(p);
|
|
end
|
|
else
|
|
Result:=copy(Result,1,p-1)+copy(Result,EndPos,length(Result));
|
|
end else
|
|
inc(p);
|
|
end;
|
|
//DebugLn(['TSimpleHTMLControl.HTMLToCaption "',dbgstr(Result),'"']);
|
|
end;
|
|
|
|
constructor TSimpleHTMLControl.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
WordWrap := True;
|
|
Layout := tlCenter;
|
|
Alignment := taLeftJustify;
|
|
Font.Color := clInfoText;
|
|
BorderSpacing.Around := 4;
|
|
end;
|
|
|
|
function TSimpleHTMLControl.GetURL: string;
|
|
begin
|
|
Result:=FURL;
|
|
end;
|
|
|
|
procedure TSimpleHTMLControl.SetURL(const AValue: string);
|
|
var
|
|
Stream: TStream;
|
|
s: string;
|
|
NewURL: String;
|
|
begin
|
|
if Provider=nil then raise Exception.Create('TSimpleHTMLControl.SetURL missing Provider');
|
|
if FURL=AValue then exit;
|
|
NewURL:=Provider.BuildURL(Provider.BaseURL,AValue);
|
|
if FURL=NewURL then exit;
|
|
FURL:=NewURL;
|
|
try
|
|
Stream:=Provider.GetStream(FURL);
|
|
SetLength(s,Stream.Size);
|
|
if s<>'' then
|
|
Stream.Read(s[1],length(s));
|
|
Caption:=HTMLToCaption(s);
|
|
Provider.ReleaseStream(FURL);
|
|
except
|
|
on E: Exception do begin
|
|
Caption:=E.Message;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TSimpleHTMLControl.SetHTMLContent(Stream: TStream);
|
|
var
|
|
s: string;
|
|
begin
|
|
SetLength(s,Stream.Size);
|
|
if s<>'' then
|
|
Stream.Read(s[1],length(s));
|
|
Caption:=HTMLToCaption(s);
|
|
end;
|
|
|
|
procedure TSimpleHTMLControl.GetPreferredControlSize(out AWidth, AHeight: integer);
|
|
var
|
|
DC: HDC;
|
|
R: TRect;
|
|
OldFont: HGDIOBJ;
|
|
Flags: Cardinal;
|
|
LabelText: String;
|
|
begin
|
|
AWidth:=0;
|
|
AHeight:=0;
|
|
DC := GetDC(Parent.Handle);
|
|
try
|
|
R := Rect(0, 0, 600, 200);
|
|
OldFont := SelectObject(DC, HGDIOBJ(Font.Reference.Handle));
|
|
Flags := DT_CALCRECT or DT_EXPANDTABS;
|
|
inc(Flags, DT_WordBreak);
|
|
LabelText := GetLabelText;
|
|
DrawText(DC, PChar(LabelText), Length(LabelText), R, Flags);
|
|
SelectObject(DC, OldFont);
|
|
AWidth := R.Right - R.Left + 8; // border
|
|
AHeight := R.Bottom - R.Top + 8; // border
|
|
finally
|
|
ReleaseDC(Parent.Handle, DC);
|
|
end;
|
|
//DebugLn(['TSimpleHTMLControl.GetPreferredControlSize Caption="',Caption,'" ',AWidth,'x',AHeight]);
|
|
end;
|
|
|
|
{ TLazIDEHTMLProvider }
|
|
|
|
procedure TLazIDEHTMLProvider.SetProviders(const AValue: TLIHProviders);
|
|
begin
|
|
if FProviders=AValue then exit;
|
|
FProviders:=AValue;
|
|
end;
|
|
|
|
function TLazIDEHTMLProvider.GetStream(const URL: string): TStream;
|
|
begin
|
|
Result:=FProviders.GetStream(URL);
|
|
end;
|
|
|
|
procedure TLazIDEHTMLProvider.ReleaseStream(const URL: string);
|
|
begin
|
|
FProviders.ReleaseStream(URL);
|
|
end;
|
|
|
|
{ TLIHProviders }
|
|
|
|
constructor TLIHProviders.Create;
|
|
begin
|
|
FStreams:=TAVLTree.Create(@CompareLIHProviderStream);
|
|
end;
|
|
|
|
destructor TLIHProviders.Destroy;
|
|
begin
|
|
FStreams.FreeAndClear;
|
|
FreeAndNil(FStreams);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TLIHProviders.FindStream(const URL: string; CreateIfNotExists: Boolean
|
|
): TLIHProviderStream;
|
|
var
|
|
Node: TAVLTreeNode;
|
|
begin
|
|
if URL='' then
|
|
exit(nil);
|
|
Node:=FStreams.FindKey(Pointer(URL),@CompareURLWithLIHProviderStream);
|
|
if Node<>nil then begin
|
|
Result:=TLIHProviderStream(Node.Data);
|
|
end else if CreateIfNotExists then begin
|
|
Result:=TLIHProviderStream.Create;
|
|
Result.URL:=URL;
|
|
FStreams.Add(Result);
|
|
end else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TLIHProviders.GetStream(const URL: string): TStream;
|
|
|
|
procedure OpenFile(out Stream: TStream; const Filename: string);
|
|
var
|
|
fs: TFileStream;
|
|
ok: Boolean;
|
|
begin
|
|
fs:=nil;
|
|
ok:=false;
|
|
try
|
|
fs:=TFileStream.Create(UTF8ToSys(Filename),fmOpenRead);
|
|
//DebugLn(['OpenFile ',Filename,' ',fs.Size,' ',fs.Position]);
|
|
Stream:=fs;
|
|
ok:=true;
|
|
finally
|
|
if not ok then
|
|
fs.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
{const
|
|
HTML =
|
|
'<HTML>'+#10
|
|
+'<BODY>'+#10
|
|
+'Test'+#10
|
|
+'</BODY>'+#10
|
|
+'</HTML>';}
|
|
var
|
|
Stream: TLIHProviderStream;
|
|
URLType: string;
|
|
URLPath: string;
|
|
URLParams: string;
|
|
begin
|
|
if URL='' then raise Exception.Create('TLIHProviders.GetStream no URL');
|
|
Stream:=FindStream(URL,true);
|
|
Stream.IncreaseRefCount;
|
|
Result:=Stream.Stream;
|
|
try
|
|
if Result=nil then begin
|
|
SplitURL(URL,URLType,URLPath,URLParams);
|
|
DebugLn(['TLIHProviders.GetStream URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams]);
|
|
if URLType='lazdoc' then begin
|
|
if copy(URLPath,1,8)='lazarus/' then begin
|
|
URLPath:=copy(URLPath,9,length(URLPath));
|
|
if (URLPath='index.html')
|
|
or (URLPath='images/laztitle.jpg')
|
|
or (URLPath='images/cheetah1.png') then begin
|
|
OpenFile(Result,EnvironmentOptions.LazarusDirectory+PathDelim+'docs'+PathDelim+URLPath);
|
|
end;
|
|
end;
|
|
end else begin
|
|
|
|
end;
|
|
{Result:=TMemoryStream.Create;
|
|
Stream.Stream:=Result;
|
|
Result.Write(HTML[1],length(HTML));
|
|
Result.Position:=0;}
|
|
if Result=nil then
|
|
raise Exception.Create('TLIHProviders.GetStream: URL not found "'+dbgstr(URL)+'"');
|
|
Stream.Stream:=Result;
|
|
end;
|
|
finally
|
|
if Result=nil then
|
|
ReleaseStream(URL);
|
|
end;
|
|
end;
|
|
|
|
procedure TLIHProviders.ReleaseStream(const URL: string);
|
|
var
|
|
Stream: TLIHProviderStream;
|
|
begin
|
|
Stream:=FindStream(URL,false);
|
|
if Stream=nil then
|
|
raise Exception.Create('TLIHProviders.ReleaseStream "'+URL+'"');
|
|
Stream.DecreaseRefCount;
|
|
if Stream.RefCount=0 then begin
|
|
FStreams.Remove(Stream);
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
{ TLIHProviderStream }
|
|
|
|
destructor TLIHProviderStream.Destroy;
|
|
begin
|
|
FreeAndNil(Stream);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TLIHProviderStream.IncreaseRefCount;
|
|
begin
|
|
inc(FRefCount);
|
|
end;
|
|
|
|
procedure TLIHProviderStream.DecreaseRefCount;
|
|
begin
|
|
if FRefCount<=0 then
|
|
raise Exception.Create('TLIHProviderStream.DecreaseRefCount');
|
|
dec(FRefCount);
|
|
end;
|
|
|
|
{ THelpSelectorDialog }
|
|
|
|
procedure THelpSelectorDialog.HelpSelectorDialogClose(Sender: TObject;
|
|
var CloseAction: TCloseAction);
|
|
begin
|
|
IDEDialogLayoutList.SaveLayout(Self);
|
|
end;
|
|
|
|
procedure THelpSelectorDialog.NodesListBoxDblClick(Sender: TObject);
|
|
begin
|
|
ModalResult := mrOK;
|
|
end;
|
|
|
|
procedure THelpSelectorDialog.SetNodes(const AValue: THelpNodeQueryList);
|
|
begin
|
|
if FNodes=AValue then exit;
|
|
FNodes:=AValue;
|
|
FillNodesListBox;
|
|
end;
|
|
|
|
procedure THelpSelectorDialog.FillNodesListBox;
|
|
var
|
|
List: TStringList;
|
|
i: Integer;
|
|
NodeQuery: THelpNodeQuery;
|
|
begin
|
|
List:=TStringList.Create;
|
|
if (Nodes<>nil) then begin
|
|
for i:=0 to Nodes.Count-1 do begin
|
|
NodeQuery:=Nodes[i];
|
|
List.Add(NodeQuery.AsString);
|
|
end;
|
|
end;
|
|
NodesListBox.Items.Assign(List);
|
|
List.Free;
|
|
end;
|
|
|
|
constructor THelpSelectorDialog.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
IDEDialogLayoutList.ApplyLayout(Self,500,300);
|
|
|
|
Caption := lisHelpSelectorDialog;
|
|
NodesGroupBox.Caption:=lisSelectAHelpItem;
|
|
BtnPanel.OKButton.Caption:=lisLazBuildOk;
|
|
end;
|
|
|
|
{ TIDEHelpDatabases }
|
|
|
|
function TIDEHelpDatabases.ShowHelpSelector(Query: THelpQuery;
|
|
Nodes: THelpNodeQueryList;
|
|
var ErrMsg: string;
|
|
var Selection: THelpNodeQuery
|
|
): TShowHelpResult;
|
|
var
|
|
Dialog: THelpSelectorDialog;
|
|
i: LongInt;
|
|
begin
|
|
Selection:=nil;
|
|
Result:=shrNone;
|
|
Dialog:=THelpSelectorDialog.Create(nil);
|
|
try
|
|
Dialog.Nodes:=Nodes;
|
|
if Dialog.ShowModal=mrOk then begin
|
|
i:=Dialog.NodesListBox.ItemIndex;
|
|
if i>=0 then begin
|
|
Selection:=Nodes[i];
|
|
Result:=shrSuccess;
|
|
end;
|
|
end else begin
|
|
Result:=shrCancel;
|
|
end;
|
|
finally
|
|
Dialog.Free;
|
|
end;
|
|
end;
|
|
|
|
function TIDEHelpDatabases.GetBaseDirectoryForBasePathObject(
|
|
BasePathObject: TObject): string;
|
|
begin
|
|
Result:='';
|
|
DebugLn('TIDEHelpDatabases.GetBaseDirectoryForBasePathObject BasePathObject=',dbgsName(BasePathObject));
|
|
if (BasePathObject is THelpBasePathObject) then
|
|
Result:=THelpBasePathObject(BasePathObject).BasePath
|
|
else if (BasePathObject=HelpBoss) or (BasePathObject=MainIDEInterface) then
|
|
Result:=EnvironmentOptions.LazarusDirectory
|
|
else if BasePathObject is TProject then
|
|
Result:=TProject(BasePathObject).ProjectDirectory
|
|
else if BasePathObject is TLazPackage then
|
|
Result:=TLazPackage(BasePathObject).Directory;
|
|
if Result<>'' then
|
|
IDEMacros.SubstituteMacros(Result);
|
|
Result:=AppendPathDelim(Result);
|
|
end;
|
|
|
|
function TIDEHelpDatabases.ShowHelpForSourcePosition(
|
|
Query: THelpQuerySourcePosition; var ErrMsg: string): TShowHelpResult;
|
|
begin
|
|
Result:=HelpBoss.ShowHelpForSourcePosition(Query.Filename,
|
|
Query.SourcePosition,ErrMsg);
|
|
end;
|
|
|
|
function TIDEHelpDatabases.SubstituteMacros(var s: string): boolean;
|
|
begin
|
|
Result:=IDEMacros.SubstituteMacros(s);
|
|
end;
|
|
|
|
{ TIDEHelpManager }
|
|
|
|
procedure TIDEHelpManager.mnuHelpAboutLazarusClicked(Sender: TObject);
|
|
begin
|
|
ShowAboutForm;
|
|
end;
|
|
|
|
procedure TIDEHelpManager.mnuHelpOnlineHelpClicked(Sender: TObject);
|
|
begin
|
|
ShowLazarusHelpStartPage;
|
|
end;
|
|
|
|
procedure TIDEHelpManager.mnuHelpReportBugClicked(Sender: TObject);
|
|
begin
|
|
OpenURL(lisReportingBugURL);
|
|
end;
|
|
|
|
procedure TIDEHelpManager.RegisterIDEHelpDatabases;
|
|
|
|
procedure CreateMainIDEHelpDB;
|
|
var
|
|
StartNode: THelpNode;
|
|
HTMLHelp: THTMLHelpDatabase;
|
|
begin
|
|
FMainHelpDB:=HelpDatabases.CreateHelpDatabase(lihcStartPage,
|
|
THTMLHelpDatabase,true);
|
|
HTMLHelp:=FMainHelpDB as THTMLHelpDatabase;
|
|
FMainHelpDBPath:=THelpBasePathObject.Create('$(LazarusDir)/docs');
|
|
HTMLHelp.BasePathObject:=FMainHelpDBPath;
|
|
|
|
// HTML nodes for the IDE
|
|
StartNode:=THelpNode.CreateURLID(HTMLHelp,'Lazarus',
|
|
'file://index.html',lihcStartPage);
|
|
HTMLHelp.TOCNode:=THelpNode.Create(HTMLHelp,StartNode);// once as TOC
|
|
HTMLHelp.RegisterItemWithNode(StartNode);// and once as normal page
|
|
end;
|
|
|
|
procedure CreateRTLHelpDB;
|
|
var
|
|
HTMLHelp: TFPDocHTMLHelpDatabase;
|
|
FPDocNode: THelpNode;
|
|
DirItem: THelpDBISourceDirectory;
|
|
begin
|
|
FRTLHelpDB:=HelpDatabases.CreateHelpDatabase(lihcRTLUnits,
|
|
TFPDocHTMLHelpDatabase,true);
|
|
HTMLHelp:=FRTLHelpDB as TFPDocHTMLHelpDatabase;
|
|
HTMLHelp.DefaultBaseURL:=lihRTLURL;
|
|
FRTLHelpDBPath:=THelpBaseURLObject.Create;
|
|
HTMLHelp.BasePathObject:=FRTLHelpDBPath;
|
|
|
|
// FPDoc nodes for units in the RTL
|
|
FPDocNode:=THelpNode.CreateURL(HTMLHelp,
|
|
'RTL - Free Pascal Run Time Library Units',
|
|
'file://index.html');
|
|
HTMLHelp.TOCNode:=THelpNode.Create(HTMLHelp,FPDocNode);// once as TOC
|
|
DirItem:=THelpDBISourceDirectory.Create(FPDocNode,'$(FPCSrcDir)/rtl',
|
|
'*.pp;*.pas',true);// and once as normal page
|
|
HTMLHelp.RegisterItem(DirItem);
|
|
end;
|
|
|
|
procedure CreateFCLHelpDB;
|
|
var
|
|
HTMLHelp: TFPDocHTMLHelpDatabase;
|
|
FPDocNode: THelpNode;
|
|
DirItem: THelpDBISourceDirectory;
|
|
begin
|
|
FFCLHelpDB:=HelpDatabases.CreateHelpDatabase(lihcFCLUnits,
|
|
TFPDocHTMLHelpDatabase,true);
|
|
HTMLHelp:=FFCLHelpDB as TFPDocHTMLHelpDatabase;
|
|
HTMLHelp.DefaultBaseURL:=lihFCLURL;
|
|
FFCLHelpDBPath:=THelpBaseURLObject.Create;
|
|
HTMLHelp.BasePathObject:=FFCLHelpDBPath;
|
|
|
|
// FPDoc nodes for units in the FCL
|
|
// create TOC
|
|
HTMLHelp.TOCNode:=THelpNode.CreateURL(HTMLHelp,
|
|
'FCL - Free Pascal Component Library Units',
|
|
'file://index.html');
|
|
|
|
// fpc 2.0.x FCL source directory
|
|
FPDocNode:=THelpNode.CreateURL(HTMLHelp,
|
|
'FCL - Free Pascal Component Library Units (2.0.x)',
|
|
'file://index.html');
|
|
DirItem:=THelpDBISourceDirectory.Create(FPDocNode,
|
|
'$(FPCSrcDir)/fcl/inc','*.pp;*.pas',false);
|
|
HTMLHelp.RegisterItem(DirItem);
|
|
|
|
// fpc 2.2.x FCL source directory
|
|
FPDocNode:=THelpNode.CreateURL(HTMLHelp,
|
|
'FCL - Free Pascal Component Library Units',
|
|
'file://index.html');
|
|
DirItem:=THelpDBISourceDirectory.Create(FPDocNode,
|
|
'$(FPCSrcDir)/packages/fcl-base/src','*.pp;*.pas',true);
|
|
HTMLHelp.RegisterItem(DirItem);
|
|
end;
|
|
|
|
procedure CreateLCLHelpDB;
|
|
var
|
|
HTMLHelp: TFPDocHTMLHelpDatabase;
|
|
FPDocNode: THelpNode;
|
|
DirItem: THelpDBISourceDirectory;
|
|
begin
|
|
FLCLHelpDB:=HelpDatabases.CreateHelpDatabase(lihcLCLUnits,
|
|
TFPDocHTMLHelpDatabase,true);
|
|
HTMLHelp:=FLCLHelpDB as TFPDocHTMLHelpDatabase;
|
|
HTMLHelp.DefaultBaseURL:=lihLCLURL;
|
|
FLCLHelpDBPath:=THelpBaseURLObject.Create;
|
|
HTMLHelp.BasePathObject:=FLCLHelpDBPath;
|
|
|
|
// FPDoc nodes for units in the LCL
|
|
FPDocNode:=THelpNode.CreateURL(HTMLHelp,
|
|
'LCL - Lazarus Component Library Units',
|
|
'file://index.html');
|
|
HTMLHelp.TOCNode:=THelpNode.Create(HTMLHelp,FPDocNode);// once as TOC
|
|
DirItem:=THelpDBISourceDirectory.Create(FPDocNode,'$(LazarusDir)/lcl',
|
|
'*.pp;*.pas',false);// and once as normal page
|
|
HTMLHelp.RegisterItem(DirItem);
|
|
end;
|
|
|
|
begin
|
|
CreateMainIDEHelpDB;
|
|
CreateRTLHelpDB;
|
|
CreateFCLHelpDB;
|
|
CreateLCLHelpDB;
|
|
CreateFPCMessagesHelpDB;
|
|
end;
|
|
|
|
procedure TIDEHelpManager.RegisterDefaultIDEHelpViewers;
|
|
var
|
|
HelpViewer: THTMLBrowserHelpViewer;
|
|
begin
|
|
HelpViewer:= THTMLBrowserHelpViewer.Create(nil);
|
|
HelpViewer.OnFindDefaultBrowser := @FindDefaultBrowser;
|
|
HelpViewers.RegisterViewer(HelpViewer);
|
|
end;
|
|
|
|
procedure TIDEHelpManager.FindDefaultBrowser(var DefaultBrowser, Params: string);
|
|
begin
|
|
GetDefaultBrowser(DefaultBrowser, Params);
|
|
end;
|
|
|
|
constructor TIDEHelpManager.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
HelpBoss:=Self;
|
|
LazarusHelp:=Self;
|
|
HelpOpts:=THelpOptions.Create;
|
|
HelpOpts.SetDefaultFilename;
|
|
HelpDatabases:=TIDEHelpDatabases.Create;
|
|
HelpIntfs.HelpManager:=HelpDatabases;
|
|
HelpViewers:=THelpViewers.Create;
|
|
RegisterIDEHelpDatabases;
|
|
RegisterDefaultIDEHelpViewers;
|
|
|
|
CodeHelpBoss:=TCodeHelpManager.Create;
|
|
|
|
// register property editors for URL handling
|
|
RegisterPropertyEditor(TypeInfo(AnsiString),
|
|
THTMLHelpDatabase,'BaseURL',TURLDirectoryPropertyEditor);
|
|
|
|
FHTMLProviders:=TLIHProviders.Create;
|
|
|
|
if CreateIDEHTMLControl=nil then
|
|
CreateIDEHTMLControl:=@LazCreateIDEHTMLControl;
|
|
if CreateIDEHTMLProvider=nil then
|
|
CreateIDEHTMLProvider:=@LazCreateIDEHTMLProvider;
|
|
end;
|
|
|
|
destructor TIDEHelpManager.Destroy;
|
|
begin
|
|
FreeThenNil(FHTMLProviders);
|
|
FreeThenNil(CodeHelpBoss);
|
|
FPCMessagesHelpDB:=nil;
|
|
FreeLCLHelpSystem;
|
|
FreeThenNil(HelpOpts);
|
|
FreeThenNil(FMainHelpDBPath);
|
|
FreeThenNil(FRTLHelpDBPath);
|
|
FreeThenNil(FFCLHelpDBPath);
|
|
FreeThenNil(FLCLHelpDBPath);
|
|
HelpBoss:=nil;
|
|
LazarusHelp:=nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TIDEHelpManager.UpdateFPCDocsHTMLDirectory;
|
|
|
|
function IsFPCDocsHTMDirectory(Directory: string): boolean;
|
|
var
|
|
RefFilename: String;
|
|
begin
|
|
Result:=false;
|
|
if Directory='' then exit;
|
|
RefFilename:=AppendPathDelim(TrimFilename(Directory))
|
|
+'ref'+PathDelim+'ref.kwd';
|
|
Result:=FileExistsUTF8(RefFilename);
|
|
//DebugLn(['IsFPCDocsHTMDirectory RefFilename="',RefFilename,'" Result=',Result]);
|
|
end;
|
|
|
|
function TryDirectory(const Directory: string): boolean;
|
|
var
|
|
NewDir: String;
|
|
begin
|
|
NewDir:=CleanAndExpandDirectory(Directory);
|
|
if not IsFPCDocsHTMDirectory(NewDir) then exit(false);
|
|
HelpOpts.FPCDocsHTMLDirectory:=NewDir;
|
|
DebugLn(['TryDirectory Changing FPCDocsHTMLDirectory to "',HelpOpts.FPCDocsHTMLDirectory,'"']);
|
|
SaveHelpOptions;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TryDirectoryMask(const Directory: string): boolean;
|
|
var
|
|
DirMask: String;
|
|
CurDir: String;
|
|
FileInfo: TSearchRec;
|
|
NewDir: String;
|
|
begin
|
|
Result:=false;
|
|
DirMask:=TrimFilename(Directory);
|
|
CurDir:=ExtractFilePath(DirMask);
|
|
if FindFirstUTF8(DirMask,faDirectory,FileInfo)=0 then begin
|
|
repeat
|
|
// skip special files
|
|
if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
|
|
continue;
|
|
if ((FileInfo.Attr and faDirectory)>0) then begin
|
|
NewDir:=CurDir+FileInfo.Name;
|
|
if TryDirectory(NewDir) then
|
|
exit(true);
|
|
end;
|
|
until FindNextUTF8(FileInfo)<>0;
|
|
end;
|
|
FindCloseUTF8(FileInfo);
|
|
end;
|
|
|
|
function SearchInCommonInstallDir: boolean;
|
|
var
|
|
SystemPPU: String;
|
|
p: LongInt;
|
|
FPCInstallDir: String;
|
|
FPCVersion: String;
|
|
CurUnitName: String;
|
|
begin
|
|
Result:=false;
|
|
{ Linux:
|
|
normally fpc ppu are installed in
|
|
/somewhere/lib/fpc/$fpcversion/units/$fpctarget/
|
|
and the docs are installed in
|
|
/somewhere/share/doc/fpcdocs-$fpcversion/
|
|
}
|
|
CurUnitName:='system.ppu';
|
|
SystemPPU:=CodeToolBoss.DirectoryCachePool.FindCompiledUnitInCompletePath(
|
|
'',CurUnitName);
|
|
DebugLn(['SearchInCommonInstallDir SystemPPU=',SystemPPU]);
|
|
// SystemPPU is now e.g. /usr/lib/fpc/2.0.4/units/i386-linux/rtl/system.ppu
|
|
if SystemPPU='' then exit;
|
|
p:=System.Pos(PathDelim+'fpc'+PathDelim,SystemPPU);
|
|
if p<1 then exit;
|
|
FPCInstallDir:=copy(SystemPPU,1,p);// FPCInstallDir is now e.g. /usr/lib/
|
|
FPCVersion:=copy(SystemPPU,p+5,length(SystemPPU));
|
|
p:=System.Pos(PathDelim,FPCVersion);
|
|
FPCVersion:=copy(FPCVersion,1,p-1);// FPCVersion is now e.g. 2.0.4
|
|
DebugLn(['SearchInCommonInstallDir FPCInstallDir="',FPCInstallDir,'" FPCVersion="',FPCVersion,'"']);
|
|
// try first with the current fpc version
|
|
if (FPCVersion<>'') then begin
|
|
if TryDirectory(FPCInstallDir
|
|
+SetDirSeparators('../share/doc/fpdocs-'+FPCVersion))
|
|
then exit;
|
|
if TryDirectory(FPCInstallDir+SetDirSeparators('doc/fpdocs-'+FPCVersion))
|
|
then exit;
|
|
end;
|
|
// try any fpc version
|
|
if TryDirectoryMask(FPCInstallDir
|
|
+SetDirSeparators('../share/doc/fpdocs-*'))
|
|
then exit;
|
|
if TryDirectoryMask(FPCInstallDir+SetDirSeparators('doc/fpdocs-*')) then
|
|
exit;
|
|
end;
|
|
|
|
begin
|
|
if IsFPCDocsHTMDirectory(HelpOpts.GetEffectiveFPCDocsHTMLDirectory) then exit;
|
|
// search the docs at common places
|
|
if SearchInCommonInstallDir then exit;
|
|
if TryDirectoryMask('/usr/share/doc/fpdocs-*') then exit;
|
|
if TryDirectoryMask('/usr/local/share/doc/fpdocs-*') then exit;
|
|
end;
|
|
|
|
procedure TIDEHelpManager.ConnectMainBarEvents;
|
|
begin
|
|
with MainIDEBar do
|
|
begin
|
|
itmHelpAboutLazarus.OnClick := @mnuHelpAboutLazarusClicked;
|
|
itmHelpOnlineHelp.OnClick := @mnuHelpOnlineHelpClicked;
|
|
itmHelpReportingBug.OnClick := @mnuHelpReportBugClicked;
|
|
end;
|
|
end;
|
|
|
|
procedure TIDEHelpManager.LoadHelpOptions;
|
|
begin
|
|
HelpOpts.Load;
|
|
end;
|
|
|
|
procedure TIDEHelpManager.SaveHelpOptions;
|
|
begin
|
|
HelpOpts.Save;
|
|
end;
|
|
|
|
procedure TIDEHelpManager.ShowLazarusHelpStartPage;
|
|
begin
|
|
ShowIDEHelpForKeyword(lihcStartPage);
|
|
end;
|
|
|
|
procedure TIDEHelpManager.ShowIDEHelpForContext(HelpContext: THelpContext);
|
|
begin
|
|
ShowHelpOrErrorForContext(MainHelpDB.ID,HelpContext);
|
|
end;
|
|
|
|
procedure TIDEHelpManager.ShowIDEHelpForKeyword(const Keyword: string);
|
|
begin
|
|
ShowHelpOrErrorForKeyword(MainHelpDB.ID,Keyword);
|
|
end;
|
|
|
|
function TIDEHelpManager.ShowHelpForSourcePosition(const Filename: string;
|
|
const CodePos: TPoint; var ErrMsg: string): TShowHelpResult;
|
|
|
|
function ShowHelpForFPCKeyWord(const KeyWord: string): TShowHelpResult;
|
|
var
|
|
RefFilename: String;
|
|
i: Integer;
|
|
List: TStrings;
|
|
Line: string;
|
|
FileStartPos: Integer;
|
|
FileEndPos: LongInt;
|
|
HTMLFilename: String;
|
|
begin
|
|
Result:=shrHelpNotFound;
|
|
if Keyword='' then exit;
|
|
UpdateFPCDocsHTMLDirectory;
|
|
RefFilename:=HelpOpts.GetEffectiveFPCDocsHTMLDirectory;
|
|
if (RefFilename='') then exit;
|
|
RefFilename:=AppendPathDelim(RefFilename)+'ref'+PathDelim+'ref.kwd';
|
|
if not FileExistsUTF8(RefFilename) then begin
|
|
DebugLn(['ShowHelpForFPCKeyWord file not found RefFilename="',RefFilename,'"']);
|
|
exit;
|
|
end;
|
|
List:=nil;
|
|
try
|
|
if LoadStringListFromFile(RefFilename,'FPC keyword list',List)<>mrOk then
|
|
exit;
|
|
for i:=0 to List.Count-1 do begin
|
|
// example: integer=refsu5.html#keyword:integer
|
|
Line:=List[i];
|
|
if (length(Line)>length(KeyWord))
|
|
and (Line[length(KeyWord)+1]='=')
|
|
and (SysUtils.CompareText(KeyWord,copy(Line,1,length(KeyWord)))=0) then
|
|
begin
|
|
FileStartPos:=length(KeyWord)+2;
|
|
FileEndPos:=FileStartPos;
|
|
while (FileEndPos<=length(Line)) and (Line[FileEndPos]<>'#') do
|
|
inc(FileEndPos);
|
|
HTMLFilename:=copy(Line,FileStartPos,FileEndPos-FileStartPos);
|
|
HTMLFilename:=HelpOpts.GetEffectiveFPCDocsHTMLDirectory+'ref'
|
|
+PathDelim+HTMLFilename;
|
|
Result:=ShowHelpFileOrError(HTMLFilename,
|
|
'FPC help for keyword "'+KeyWord+'"',
|
|
'text/html');
|
|
break;
|
|
end;
|
|
end;
|
|
finally
|
|
List.Free;
|
|
end;
|
|
end;
|
|
|
|
function CollectKeyWords(CodeBuffer: TCodeBuffer): TShowHelpResult;
|
|
// true: help found
|
|
var
|
|
p: Integer;
|
|
IdentStart, IdentEnd: integer;
|
|
KeyWord: String;
|
|
begin
|
|
Result:=shrHelpNotFound;
|
|
p:=0;
|
|
CodeBuffer.LineColToPosition(CodePos.Y,CodePos.X,p);
|
|
if p<1 then exit;
|
|
GetIdentStartEndAtPosition(CodeBuffer.Source,p,IdentStart,IdentEnd);
|
|
if IdentEnd<=IdentStart then exit;
|
|
KeyWord:=copy(CodeBuffer.Source,IdentStart,IdentEnd-IdentStart);
|
|
Result:=ShowHelpForFPCKeyWord(KeyWord);
|
|
end;
|
|
|
|
procedure CollectDeclarations(CodeBuffer: TCodeBuffer);
|
|
var
|
|
NewList: TPascalHelpContextList;
|
|
PascalHelpContextLists: TList;
|
|
ListOfPCodeXYPosition: TFPList;
|
|
CurCodePos: PCodeXYPosition;
|
|
i: Integer;
|
|
begin
|
|
ListOfPCodeXYPosition:=nil;
|
|
PascalHelpContextLists:=nil;
|
|
try
|
|
// get all possible declarations of this identifier
|
|
if CodeToolBoss.FindDeclarationAndOverload(CodeBuffer,CodePos.X,CodePos.Y,
|
|
ListOfPCodeXYPosition,[fdlfWithoutEmptyProperties,fdlfWithoutForwards])
|
|
then begin
|
|
if ListOfPCodeXYPosition=nil then exit;
|
|
debugln('TIDEHelpManager.ShowHelpForSourcePosition B Success ',dbgs(ListOfPCodeXYPosition.Count));
|
|
// convert the source positions in pascal help context list
|
|
for i:=0 to ListOfPCodeXYPosition.Count-1 do begin
|
|
CurCodePos:=PCodeXYPosition(ListOfPCodeXYPosition[i]);
|
|
debugln('TIDEHelpManager.ShowHelpForSourcePosition C ',CurCodePos^.Code.Filename,' X=',dbgs(CurCodePos^.X),' Y=',dbgs(CurCodePos^.Y));
|
|
NewList:=ConvertCodePosToPascalHelpContext(CurCodePos);
|
|
if NewList<>nil then begin
|
|
if PascalHelpContextLists=nil then
|
|
PascalHelpContextLists:=TList.Create;
|
|
PascalHelpContextLists.Add(NewList);
|
|
end;
|
|
end;
|
|
if PascalHelpContextLists=nil then exit;
|
|
|
|
// invoke help system
|
|
debugln('TIDEHelpManager.ShowHelpForSourcePosition D PascalHelpContextLists.Count=',dbgs(PascalHelpContextLists.Count));
|
|
Result:=ShowHelpForPascalContexts(Filename,CodePos,PascalHelpContextLists,ErrMsg);
|
|
end else begin
|
|
MainIDEInterface.DoJumpToCodeToolBossError;
|
|
end;
|
|
finally
|
|
FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
|
|
if PascalHelpContextLists<>nil then begin
|
|
for i:=0 to PascalHelpContextLists.Count-1 do
|
|
TObject(PascalHelpContextLists[i]).Free;
|
|
PascalHelpContextLists.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
CodeBuffer: TCodeBuffer;
|
|
begin
|
|
debugln('TIDEHelpManager.ShowHelpForSourcePosition A Filename=',Filename,' ',dbgs(CodePos));
|
|
Result:=shrHelpNotFound;
|
|
ErrMsg:='No help found for "'+Filename+'"'
|
|
+' at ('+IntToStr(CodePos.Y)+','+IntToStr(CodePos.X)+')';
|
|
// commit editor changes
|
|
if not CodeToolBoss.GatherExternalChanges then exit;
|
|
// get code buffer for Filename
|
|
if mrOk<>LoadCodeBuffer(CodeBuffer,FileName,[lbfCheckIfText],false) then
|
|
exit;
|
|
|
|
Result:=CollectKeyWords(CodeBuffer);
|
|
if Result=shrSuccess then exit;
|
|
CollectDeclarations(CodeBuffer);
|
|
end;
|
|
|
|
function TIDEHelpManager.ConvertCodePosToPascalHelpContext(
|
|
ACodePos: PCodeXYPosition): TPascalHelpContextList;
|
|
|
|
procedure AddContext(Descriptor: TPascalHelpContextType;
|
|
const Context: string);
|
|
var
|
|
CurContext: TPascalHelpContext;
|
|
begin
|
|
CurContext.Descriptor:=Descriptor;
|
|
CurContext.Context:=Context;
|
|
Result.Add(CurContext);
|
|
//debugln(' AddContext Descriptor=',dbgs(ord(Descriptor)),' Context="',Context,'"');
|
|
end;
|
|
|
|
procedure AddContextsBackwards(Tool: TCodeTool;
|
|
Node: TCodeTreeNode);
|
|
begin
|
|
if Node=nil then exit;
|
|
AddContextsBackwards(Tool,Node.Parent);
|
|
case Node.Desc of
|
|
ctnUnit, ctnPackage, ctnProgram, ctnLibrary:
|
|
AddContext(pihcSourceName,Tool.GetSourceName);
|
|
ctnVarDefinition:
|
|
AddContext(pihcVariable,Tool.ExtractDefinitionName(Node));
|
|
ctnTypeDefinition:
|
|
AddContext(pihcType,Tool.ExtractDefinitionName(Node));
|
|
ctnConstDefinition:
|
|
AddContext(pihcConst,Tool.ExtractDefinitionName(Node));
|
|
ctnProperty:
|
|
AddContext(pihcProperty,Tool.ExtractPropName(Node,false));
|
|
ctnProcedure:
|
|
AddContext(pihcProcedure,Tool.ExtractProcName(Node,
|
|
[phpWithoutClassName]));
|
|
ctnProcedureHead:
|
|
AddContext(pihcParameterList,Tool.ExtractProcHead(Node,
|
|
[phpWithoutClassKeyword,phpWithoutClassName,phpWithoutName,
|
|
phpWithoutSemicolon]));
|
|
end;
|
|
end;
|
|
|
|
var
|
|
MainCodeBuffer: TCodeBuffer;
|
|
Tool: TCustomCodeTool;
|
|
CleanPos: integer;
|
|
i: Integer;
|
|
Node: TCodeTreeNode;
|
|
IncludeChain: TFPList;
|
|
ConversionResult: LongInt;
|
|
begin
|
|
Result:=nil;
|
|
// find code buffer
|
|
if ACodePos^.Code=nil then begin
|
|
debugln('WARNING: ConvertCodePosToPascalHelpContext ACodePos.Code=nil');
|
|
exit;
|
|
end;
|
|
Result:=TPascalHelpContextList.Create;
|
|
// add filename and all filenames of the include chain
|
|
IncludeChain:=nil;
|
|
try
|
|
CodeToolBoss.GetIncludeCodeChain(ACodePos^.Code,true,IncludeChain);
|
|
if IncludeChain=nil then begin
|
|
debugln('WARNING: ConvertCodePosToPascalHelpContext IncludeChain=nil');
|
|
exit;
|
|
end;
|
|
for i:=0 to IncludeChain.Count-1 do
|
|
AddContext(pihcFilename,TCodeBuffer(IncludeChain[i]).Filename);
|
|
MainCodeBuffer:=TCodeBuffer(IncludeChain[0]);
|
|
finally
|
|
IncludeChain.Free;
|
|
end;
|
|
// find code tool
|
|
Tool:=CodeToolBoss.FindCodeToolForSource(MainCodeBuffer);
|
|
if not (Tool is TCodeTool) then begin
|
|
debugln('WARNING: ConvertCodePosToPascalHelpContext not (Tool is TCodeTool) MainCodeBuffer=',MainCodeBuffer.Filename);
|
|
exit;
|
|
end;
|
|
// convert cursor position to clean position
|
|
ConversionResult:=Tool.CaretToCleanPos(ACodePos^,CleanPos);
|
|
if ConversionResult<>0 then begin
|
|
// position not in clean code, maybe a comment, maybe behind last line
|
|
// => ignore
|
|
exit;
|
|
end;
|
|
// find node
|
|
Node:=Tool.FindDeepestNodeAtPos(CleanPos,false);
|
|
if Node=nil then begin
|
|
// position not in a scanned pascal node, maybe in between
|
|
// => ignore
|
|
exit;
|
|
end;
|
|
AddContextsBackwards(TCodeTool(Tool),Node);
|
|
end;
|
|
|
|
procedure TIDEHelpManager.ShowHelpForMessage(Line: integer);
|
|
|
|
function ParseMessage(MsgItem: TIDEMessageLine): TStringList;
|
|
begin
|
|
Result:=TStringList.Create;
|
|
Result.Values['Message']:=MsgItem.Msg;
|
|
if MsgItem.Parts<>nil then
|
|
Result.Assign(MsgItem.Parts);
|
|
end;
|
|
|
|
var
|
|
MsgItem: TIDEMessageLine;
|
|
MessageParts: TStringList;
|
|
begin
|
|
//debugln('TIDEHelpManager.ShowHelpForMessage A Line=',dbgs(Line));
|
|
if MessagesView=nil then exit;
|
|
if Line<0 then
|
|
Line:=MessagesView.SelectedMessageIndex;
|
|
//DebugLn('TIDEHelpManager.ShowHelpForMessage B Line=',dbgs(Line),' ',dbgs(MessagesView.VisibleItemCount));
|
|
if (Line<0) or (Line>=MessagesView.VisibleItemCount) then exit;
|
|
MsgItem:=MessagesView.VisibleItems[Line];
|
|
if MsgItem=nil then exit;
|
|
if MsgItem.Msg<>'' then begin
|
|
MessageParts:=ParseMessage(MsgItem);
|
|
ShowHelpOrErrorForMessageLine(MsgItem.Msg,MessageParts);
|
|
end;
|
|
end;
|
|
|
|
procedure TIDEHelpManager.ShowHelpForObjectInspector(Sender: TObject);
|
|
var
|
|
AnInspector: TObjectInspectorDlg;
|
|
Code: TCodeBuffer;
|
|
Caret: TPoint;
|
|
ErrMsg: string;
|
|
NewTopLine: integer;
|
|
begin
|
|
//DebugLn('TIDEHelpManager.ShowHelpForObjectInspector ',dbgsName(Sender));
|
|
if Sender=nil then Sender:=ObjectInspector1;
|
|
if Sender is TObjectInspectorDlg then begin
|
|
AnInspector:=TObjectInspectorDlg(Sender);
|
|
if AnInspector.GetActivePropertyRow<>nil then begin
|
|
if FindDeclarationOfOIProperty(AnInspector,nil,Code,Caret,NewTopLine) then
|
|
begin
|
|
if NewTopLine=0 then ;
|
|
ShowHelpForSourcePosition(Code.Filename,Caret,ErrMsg);
|
|
end;
|
|
end else begin
|
|
DebugLn('TIDEHelpManager.ShowHelpForObjectInspector show default help for OI');
|
|
ShowContextHelpForIDE(AnInspector);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TIDEHelpManager.CreateHint(aHintWindow: THintWindow; ScreenPos: TPoint;
|
|
const BaseURL: string; var TheHint: string; out HintWinRect: TRect): boolean;
|
|
var
|
|
IsHTML: Boolean;
|
|
Provider: TAbstractIDEHTMLProvider;
|
|
HTMLControl: TControl;
|
|
ms: TMemoryStream;
|
|
NewWidth, NewHeight: integer;
|
|
begin
|
|
IsHTML:=SysUtils.CompareText(copy(TheHint,1,6),'<HTML>')=0;
|
|
|
|
if aHintWindow.ControlCount>0 then begin
|
|
aHintWindow.Controls[0].Free;
|
|
end;
|
|
if IsHTML then begin
|
|
Provider:=nil;
|
|
HTMLControl:=CreateIDEHTMLControl(aHintWindow,Provider);
|
|
Provider.BaseURL:=BaseURL;
|
|
HTMLControl.Parent:=aHintWindow;
|
|
HTMLControl.Align:=alClient;
|
|
ms:=TMemoryStream.Create;
|
|
try
|
|
if TheHint<>'' then
|
|
ms.Write(TheHint[1],length(TheHint));
|
|
ms.Position:=0;
|
|
Provider.ControlIntf.SetHTMLContent(ms);
|
|
finally
|
|
ms.Free;
|
|
end;
|
|
Provider.ControlIntf.GetPreferredControlSize(NewWidth,NewHeight);
|
|
|
|
if NewWidth <= 0 then
|
|
NewWidth := 500
|
|
else
|
|
inc(NewWidth, 8); // border
|
|
|
|
if NewHeight <= 0 then
|
|
NewHeight := 200
|
|
else
|
|
inc(NewHeight, 8); // border
|
|
|
|
HintWinRect := Rect(0, 0, NewWidth, NewHeight);
|
|
TheHint := '';
|
|
end else begin
|
|
HintWinRect := aHintWindow.CalcHintRect(Screen.Width, TheHint, nil);
|
|
end;
|
|
OffsetRect(HintWinRect, ScreenPos.X, ScreenPos.Y+30);
|
|
|
|
Result:=true;
|
|
end;
|
|
|
|
function TIDEHelpManager.GetHintForSourcePosition(const ExpandedFilename: string;
|
|
const CodePos: TPoint; out BaseURL, HTMLHint: string): TShowHelpResult;
|
|
var
|
|
Code: TCodeBuffer;
|
|
CacheWasUsed: boolean;
|
|
begin
|
|
BaseURL:='';
|
|
HTMLHint:='';
|
|
Code:=CodeToolBoss.LoadFile(ExpandedFilename,true,false);
|
|
if (Code=nil) or Code.LineColIsSpace(CodePos.Y,CodePos.X) then
|
|
exit(shrHelpNotFound);
|
|
if CodeHelpBoss.GetHTMLHint(Code,CodePos.X,CodePos.Y,
|
|
[chhoSmartHint, chhoComplete, chhoComments],
|
|
BaseURL,HTMLHint,CacheWasUsed)=chprSuccess
|
|
then
|
|
exit(shrSuccess);
|
|
Result:=shrHelpNotFound;
|
|
end;
|
|
|
|
function TIDEHelpManager.ConvertSourcePosToPascalHelpContext(
|
|
const CaretPos: TPoint; const Filename: string): TPascalHelpContextList;
|
|
var
|
|
CodePos: TCodeXYPosition;
|
|
Code: TCodeBuffer;
|
|
ACodeTool: TCodeTool;
|
|
begin
|
|
Result:=nil;
|
|
Code:=CodeToolBoss.FindFile(Filename);
|
|
if Code=nil then exit;
|
|
CodePos.Code:=Code;
|
|
CodePos.X:=CaretPos.X;
|
|
CodePos.Y:=CaretPos.Y;
|
|
if not CodeToolBoss.Explore(Code,ACodeTool,false) then exit;
|
|
if ACodeTool=nil then ;
|
|
Result:=ConvertCodePosToPascalHelpContext(@CodePos);
|
|
end;
|
|
|
|
end.
|
|
|