lazarus/ide/helpmanager.pas
2004-12-16 22:09:53 +00:00

642 lines
20 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
Classes, SysUtils, LCLProc, Forms, Controls, Buttons, StdCtrls, Dialogs,
CodeToolManager, CodeAtom, CodeCache, CustomCodeTool, CodeTree,
PascalParserTool, FindDeclarationTool,
HelpIntf, HelpHTML, HelpFPDoc, MacroIntf,
LazarusIDEStrConsts, TransferMacros, DialogProcs, IDEOptionDefs,
EnvironmentOpts, AboutFrm, MsgView, Project, PackageDefs, MainBar,
HelpOptions, MainIntf;
type
{ TBaseHelpManager }
TBaseHelpManager = class(TComponent)
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
public
procedure ConnectMainBarEvents; virtual;
procedure LoadHelpOptions; virtual; abstract;
procedure SaveHelpOptions; virtual; abstract;
function ShowHelpForSourcePosition(const Filename: string;
const CodePos: TPoint;
var ErrMsg: string): TShowHelpResult; virtual; abstract;
procedure ShowHelpForMessage(Line: integer); virtual; abstract;
end;
{ TIDEHelpDatabases }
TIDEHelpDatabases = class(THelpDatabases)
public
function ShowHelpSelector(Query: THelpQuery; Nodes: TList;
var ErrMsg: string;
var Selection: THelpNode): TShowHelpResult; override;
procedure ShowError(ShowResult: TShowHelpResult; const ErrMsg: string); override;
function GetBaseDirectoryForBasePathObject(BasePathObject: TObject): string; override;
function ShowHelpForSourcePosition(Query: THelpQuerySourcePosition;
var ErrMsg: string): TShowHelpResult; override;
end;
{ THelpManager }
THelpManager = class(TBaseHelpManager)
// help menu of the IDE menu bar
procedure mnuHelpAboutLazarusClicked(Sender: TObject);
procedure mnuHelpConfigureHelpClicked(Sender: TObject);
procedure mnuHelpOnlineHelpClicked(Sender: TObject);
private
FMainHelpDB: THelpDatabase;
FRTLHelpDB: THelpDatabase;
FFCLHelpDB: THelpDatabase;
FLCLHelpDB: THelpDatabase;
procedure RegisterIDEHelpDatabases;
procedure RegisterDefaultIDEHelpViewers;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
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;
public
property MainHelpDB: THelpDatabase read FMainHelpDB;
property FCLHelpDB: THelpDatabase read FFCLHelpDB;
end;
{ Help Contexts for IDE help }
const
lihcStartPage = 'StartPage';
lihcRTLUnits = 'RTLUnits';
lihcFCLUnits = 'FCLUnits';
lihcLCLUnits = 'LCLUnits';
var
HelpBoss: TBaseHelpManager;
implementation
{ TBaseHelpManager }
constructor TBaseHelpManager.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
HelpBoss:=Self;
end;
destructor TBaseHelpManager.Destroy;
begin
HelpBoss:=nil;
inherited Destroy;
end;
procedure TBaseHelpManager.ConnectMainBarEvents;
begin
end;
{ THelpSelectorDialog }
type
THelpSelectorDialog = class(TForm)
NodesGroupBox: TGroupBox;
NodesListBox: TListBox;
OkButton: TButton;
CancelButton: TButton;
procedure HelpSelectorDialogClose(Sender: TObject;
var CloseAction: TCloseAction);
private
FNodes: TList;
procedure SetNodes(const AValue: TList);
procedure FillNodesListBox;
public
constructor Create(TheOwner: TComponent); override;
property Nodes: TList read FNodes write SetNodes;
end;
procedure THelpSelectorDialog.HelpSelectorDialogClose(Sender: TObject;
var CloseAction: TCloseAction);
begin
IDEDialogLayoutList.SaveLayout(Self);
end;
procedure THelpSelectorDialog.SetNodes(const AValue: TList);
begin
if FNodes=AValue then exit;
FNodes:=AValue;
FillNodesListBox;
end;
procedure THelpSelectorDialog.FillNodesListBox;
var
List: TStringList;
Node: THelpNode;
i: Integer;
begin
List:=TStringList.Create;
if (Nodes<>nil) then begin
for i:=0 to Nodes.Count-1 do begin
Node:=TObject(Nodes[i]) as THelpNode;
List.Add(Node.Title);
end;
end;
NodesListBox.Items.Assign(List);
List.Free;
end;
constructor THelpSelectorDialog.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
Position:=poScreenCenter;
IDEDialogLayoutList.ApplyLayout(Self,500,300);
OnClose:=@HelpSelectorDialogClose;
NodesGroupBox:=TGroupBox.Create(Self);
with NodesGroupBox do begin
Name:='NodesGroupBox';
Parent:=Self;
Left:=5;
Top:=5;
Width:=Self.ClientWidth-10;
Height:=Self.ClientWidth-40;
Anchors:=[akLeft,akTop,akRight,akBottom];
Caption:=lisSelectAHelpItem;
end;
NodesListBox:=TListBox.Create(Self);
with NodesListBox do begin
Name:='NodesListBox';
Parent:=NodesGroupBox;
Align:=alClient;
end;
OkButton:=TButton.Create(Self);
with OkButton do begin
Name:='OkButton';
Parent:=Self;
Left:=5;
Top:=Self.ClientHeight-35;
Width:=80;
Anchors:=[akLeft,akBottom];
Caption:=lisLazBuildOk;
ModalResult:=mrOk;
end;
CancelButton:=TButton.Create(Self);
with CancelButton do begin
Name:='CancelButton';
Parent:=Self;
Left:=OkButton.Left+OkButton.Width+10;
Top:=Self.ClientHeight-35;
Width:=80;
Anchors:=[akLeft,akBottom];
Caption:=dlgCancel;
ModalResult:=mrCancel;
end;
end;
{ TIDEHelpDatabases }
function TIDEHelpDatabases.ShowHelpSelector(Query: THelpQuery; Nodes: TList;
var ErrMsg: string; var Selection: THelpNode): TShowHelpResult;
var
Dialog: THelpSelectorDialog;
i: LongInt;
begin
Selection:=nil;
Result:=shrNone;
Dialog:=THelpSelectorDialog.Create(Application);
try
Dialog.Nodes:=Nodes;
if Dialog.ShowModal=mrOk then begin
i:=Dialog.NodesListBox.ItemIndex;
if i>=0 then begin
Selection:=THelpNode(Nodes[i]);
Result:=shrSuccess;
end;
end;
finally
Dialog.Free;
end;
end;
procedure TIDEHelpDatabases.ShowError(ShowResult: TShowHelpResult;
const ErrMsg: string);
var
ErrorCaption: String;
begin
case ShowResult of
shrNone: ErrorCaption:=lisCodeTemplError;
shrSuccess: exit;
shrDatabaseNotFound: ErrorCaption:=lisHelpDatabaseNotFound;
shrContextNotFound: ErrorCaption:=lisHelpContextNotFound;
shrViewerNotFound: ErrorCaption:=lisHelpViewerNotFound;
shrHelpNotFound: ErrorCaption:=lisHelpNotFound;
shrViewerError: ErrorCaption:=lisHelpViewerError;
shrSelectorError: ErrorCaption:=lisHelpSelectorError;
else ErrorCaption:=lisUnknownErrorPleaseReportThisBug;
end;
MessageDlg(ErrorCaption,ErrMsg,mtError,[mbCancel],0);
end;
function TIDEHelpDatabases.GetBaseDirectoryForBasePathObject(
BasePathObject: TObject): string;
begin
Result:='';
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;
IDEMacros.SubstituteMacros(Result);
end;
function TIDEHelpDatabases.ShowHelpForSourcePosition(
Query: THelpQuerySourcePosition; var ErrMsg: string): TShowHelpResult;
begin
Result:=HelpBoss.ShowHelpForSourcePosition(Query.Filename,
Query.SourcePosition,ErrMsg);
end;
{ THelpManager }
procedure THelpManager.mnuHelpAboutLazarusClicked(Sender: TObject);
begin
ShowAboutForm;
end;
procedure THelpManager.mnuHelpConfigureHelpClicked(Sender: TObject);
begin
if ShowHelpOptionsDialog=mrOk then
SaveHelpOptions;
end;
procedure THelpManager.mnuHelpOnlineHelpClicked(Sender: TObject);
begin
ShowLazarusHelpStartPage;
end;
procedure THelpManager.RegisterIDEHelpDatabases;
procedure CreateMainIDEHelpDB;
var
StartNode: THelpNode;
HTMLHelp: THTMLHelpDatabase;
begin
FMainHelpDB:=HelpDatabases.CreateHelpDatabase(lihcStartPage,
THTMLHelpDatabase,true);
HTMLHelp:=FMainHelpDB as THTMLHelpDatabase;
HTMLHelp.BasePathObject:=Self;
// nodes
StartNode:=THelpNode.CreateURLID(HTMLHelp,'Lazarus',
'file://docs/index.html',lihcStartPage);
HTMLHelp.TOCNode:=THelpNode.Create(HTMLHelp,StartNode);
HTMLHelp.RegisterItemWithNode(StartNode);
end;
procedure CreateRTLHelpDB;
var
HTMLHelp: TFPDocHTMLHelpDatabase;
FPDocNode: THelpNode;
DirItem: THelpDBISourceDirectory;
begin
FRTLHelpDB:=HelpDatabases.CreateHelpDatabase(lihcRTLUnits,
TFPDocHTMLHelpDatabase,true);
HTMLHelp:=FRTLHelpDB as TFPDocHTMLHelpDatabase;
// FPDoc: units in the RTL
FPDocNode:=THelpNode.CreateURL(HTMLHelp,
'RTL - Free Pascal Run Time Library Units',
'http://www.freepascal.org/docs-html/rtl/index.html');
HTMLHelp.TOCNode:=THelpNode.Create(HTMLHelp,FPDocNode);
DirItem:=THelpDBISourceDirectory.Create(FPDocNode,'$(FPCSrcDir)/rtl',
'*.pp;*.pas',true);
HTMLHelp.RegisterItem(DirItem);
end;
procedure CreateFCLHelpDB;
var
HTMLHelp: TFPDocHTMLHelpDatabase;
FPDocNode: THelpNode;
DirItem: THelpDBISourceDirectory;
begin
FFCLHelpDB:=HelpDatabases.CreateHelpDatabase(lihcFCLUnits,
TFPDocHTMLHelpDatabase,true);
HTMLHelp:=FFCLHelpDB as TFPDocHTMLHelpDatabase;
// FPDoc: units in the FCL
FPDocNode:=THelpNode.CreateURL(HTMLHelp,
'FCL - Free Pascal Component Library Units',
'http://www.freepascal.org/docs-html/fcl/index.html');
HTMLHelp.TOCNode:=THelpNode.Create(HTMLHelp,FPDocNode);
DirItem:=THelpDBISourceDirectory.Create(FPDocNode,'$(FPCSrcDir)/fcl',
'*.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.BasePathObject:=Self;
// FPDoc: units in the LCL
FPDocNode:=THelpNode.CreateURL(HTMLHelp,
'LCL - Lazarus Component Library Units',
'http://www.freepascal.org/docs-html/lcl/index.html');
// 'file://$(LazarusDir)/docs/html/index.html');
HTMLHelp.TOCNode:=THelpNode.Create(HTMLHelp,FPDocNode);
DirItem:=THelpDBISourceDirectory.Create(FPDocNode,'$(LazarusDir)/lcl',
'*.pp;*.pas',false);
HTMLHelp.RegisterItem(DirItem);
end;
begin
CreateMainIDEHelpDB;
CreateRTLHelpDB;
CreateFCLHelpDB;
CreateLCLHelpDB;
end;
procedure THelpManager.RegisterDefaultIDEHelpViewers;
begin
HelpViewers.RegisterViewer(THTMLBrowserHelpViewer.Create);
end;
constructor THelpManager.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
HelpOpts:=THelpOptions.Create;
HelpOpts.SetDefaultFilename;
HelpDatabases:=TIDEHelpDatabases.Create;
HelpViewers:=THelpViewers.Create;
RegisterIDEHelpDatabases;
RegisterDefaultIDEHelpViewers;
end;
destructor THelpManager.Destroy;
begin
FreeThenNil(HelpDatabases);
FreeThenNil(HelpViewers);
FreeThenNil(HelpOpts);
inherited Destroy;
end;
procedure THelpManager.ConnectMainBarEvents;
begin
with MainIDEBar do begin
itmHelpAboutLazarus.OnClick := @mnuHelpAboutLazarusClicked;
itmHelpOnlineHelp.OnClick :=@mnuHelpOnlineHelpClicked;
itmHelpConfigureHelp.OnClick :=@mnuHelpConfigureHelpClicked;
end;
end;
procedure THelpManager.LoadHelpOptions;
begin
HelpOpts.Load;
end;
procedure THelpManager.SaveHelpOptions;
begin
HelpOpts.Save;
end;
procedure THelpManager.ShowLazarusHelpStartPage;
begin
ShowIDEHelpForKeyword(lihcStartPage);
end;
procedure THelpManager.ShowIDEHelpForContext(HelpContext: THelpContext);
begin
ShowHelpOrErrorForContext(MainHelpDB.ID,HelpContext);
end;
procedure THelpManager.ShowIDEHelpForKeyword(const Keyword: string);
begin
ShowHelpOrErrorForKeyword(MainHelpDB.ID,Keyword);
end;
function THelpManager.ShowHelpForSourcePosition(const Filename: string;
const CodePos: TPoint; var ErrMsg: string): TShowHelpResult;
function 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,'');
end;
end;
var
MainCodeBuffer: TCodeBuffer;
Tool: TCustomCodeTool;
CleanPos: integer;
i: Integer;
Node: TCodeTreeNode;
IncludeChain: TList;
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;
var
CodeBuffer: TCodeBuffer;
i: Integer;
CurCodePos: PCodeXYPosition;
ListOfPCodeXYPosition: TList;
PascalHelpContextLists: TList;
NewList: TPascalHelpContextList;
begin
debugln('THelpManager.ShowHelpForSourcePosition A Filename=',Filename,' ',dbgs(CodePos));
Result:=shrSuccess;
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]) then
exit;
ListOfPCodeXYPosition:=nil;
PascalHelpContextLists:=nil;
try
// get all possible declarations for this identifier
if CodeToolBoss.FindDeclarationsAndAncestors(CodeBuffer,CodePos.X,CodePos.Y,
ListOfPCodeXYPosition) then
begin
debugln('THelpManager.ShowHelpForSourcePosition B Success ',dbgs(ListOfPCodeXYPosition.Count));
// convert the source positions in pascal help context list
if ListOfPCodeXYPosition=nil then exit;
for i:=0 to ListOfPCodeXYPosition.Count-1 do begin
CurCodePos:=PCodeXYPosition(ListOfPCodeXYPosition[i]);
debugln('THelpManager.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('THelpManager.ShowHelpForSourcePosition D PascalHelpContextLists.Count=',dbgs(PascalHelpContextLists.Count));
ShowHelpForPascalContexts(Filename,CodePos,PascalHelpContextLists,ErrMsg);
end else begin
MainIDEInterface.DoJumpToCodeToolBossError;
end;
finally
if ListOfPCodeXYPosition<>nil then begin
for i:=0 to ListOfPCodeXYPosition.Count-1 do begin
CurCodePos:=PCodeXYPosition(ListOfPCodeXYPosition[i]);
Dispose(CurCodePos);
end;
ListOfPCodeXYPosition.Free;
end;
if PascalHelpContextLists<>nil then begin
for i:=0 to PascalHelpContextLists.Count-1 do
TObject(PascalHelpContextLists[i]).Free;
PascalHelpContextLists.Free;
end;
end;
end;
procedure THelpManager.ShowHelpForMessage(Line: integer);
var
Msg: String;
begin
debugln('THelpManager.ShowHelpForMessage A Line=',dbgs(Line));
if MessagesView=nil then exit;
if Line<0 then
Line:=MessagesView.SelectedMessageIndex;
if (Line<0) or (Line>=MessagesView.VisibleItemCount) then exit;
Msg:=MessagesView.VisibleItems[Line].Msg;
if Msg<>'' then begin
ShowHelpOrErrorForMessageLine(Msg);
end;
end;
end.