mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-13 00:49:23 +02:00
2448 lines
70 KiB
ObjectPascal
2448 lines
70 KiB
ObjectPascal
{ $Id$ }
|
|
{
|
|
*****************************************************************************
|
|
* *
|
|
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program 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. *
|
|
* *
|
|
*****************************************************************************
|
|
|
|
Author: Mattias Gaertner
|
|
|
|
Abstract:
|
|
This unit defines various base classes for the LCL Help System.
|
|
|
|
ToDo:
|
|
- fix TCHMHelpViewer
|
|
- Make THelpDatabase and THelpViewer components usable in the designer.
|
|
- localization support.
|
|
- Add Help Editing functions
|
|
}
|
|
unit LazHelpIntf;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, LCLProc, FileUtil, LCLStrConsts, Dialogs,
|
|
LazConfigStorage, HelpIntfs, Masks;
|
|
|
|
type
|
|
{ THelpQueryItem }
|
|
|
|
THelpQueryItem = class
|
|
public
|
|
function AsString: string; virtual; abstract;
|
|
function IsEqual(QueryItem: THelpQueryItem): boolean; virtual;
|
|
end;
|
|
|
|
{ TPascalHelpContextList }
|
|
|
|
TPascalHelpContextType = (
|
|
pihcFilename,
|
|
pihcSourceName, // unit name, library name, ..
|
|
pihcProperty,
|
|
pihcProcedure,
|
|
pihcParameterList,
|
|
pihcVariable,
|
|
pihcType,
|
|
pihcConst
|
|
);
|
|
TPascalHelpContext = record
|
|
Descriptor: TPascalHelpContextType;
|
|
Context: string;
|
|
end;
|
|
TPascalHelpContextPtr = ^TPascalHelpContext;
|
|
|
|
TPascalHelpContextList = class(THelpQueryItem)
|
|
private
|
|
FCount: integer;
|
|
fItems: TPascalHelpContextPtr;
|
|
function GetItems(Index: integer): TPascalHelpContext;
|
|
public
|
|
procedure Add(const Context: TPascalHelpContext);
|
|
procedure Insert(Index: integer; const Context: TPascalHelpContext);
|
|
procedure Clear;
|
|
destructor Destroy; override;
|
|
function IsEqual(QueryItem: THelpQueryItem): boolean; override;
|
|
function CompareList(AList: TPascalHelpContextList): integer;
|
|
function AsString: string; override;
|
|
public
|
|
property Count: integer read FCount;
|
|
property Items[Index: integer]: TPascalHelpContext read GetItems;
|
|
property List: TPascalHelpContextPtr read fItems;
|
|
end;
|
|
|
|
|
|
THelpDatabase = class;
|
|
|
|
{ THelpNode
|
|
A help node is a position/place in a help database.
|
|
For example it points to a Help file or to a Link on a HTML file. }
|
|
|
|
THelpNodeType = (
|
|
hntURLIDContext, // URL, ID and Context valid
|
|
hntURL, // URL valid, ignore ID and Context
|
|
hntURLID, // URL and ID valid, ignore Context
|
|
hntID, // ID valid, ignore URL and Context
|
|
hntContext, // Context valid, ignore URL and ID
|
|
hntURLContext // URL and Context valid, ignore ID
|
|
);
|
|
|
|
THelpNode = class(TPersistent)
|
|
private
|
|
FContext: THelpContext;
|
|
FURL: string;
|
|
FHelpType: THelpNodeType;
|
|
fID: string;
|
|
FOwner: THelpDatabase;
|
|
FTitle: string;
|
|
public
|
|
constructor Create(TheOwner: THelpDatabase; Node: THelpNode);
|
|
constructor Create(TheOwner: THelpDatabase;
|
|
const TheTitle, TheURL, TheID: string;
|
|
TheContext: THelpContext);
|
|
constructor CreateURL(TheOwner: THelpDatabase;
|
|
const TheTitle, TheURL: string);
|
|
constructor CreateID(TheOwner: THelpDatabase; const TheTitle, TheID: string);
|
|
constructor CreateURLID(TheOwner: THelpDatabase; const TheTitle,
|
|
TheURL, TheID: string);
|
|
constructor CreateContext(TheOwner: THelpDatabase; const TheTitle: string;
|
|
TheContext: THelpContext);
|
|
constructor CreateURLContext(TheOwner: THelpDatabase;
|
|
const TheTitle, TheURL: string;
|
|
TheContext: THelpContext);
|
|
public
|
|
property Owner: THelpDatabase read FOwner write FOwner;
|
|
function URLValid: boolean;
|
|
function IDValid: boolean;
|
|
function ContextValid: boolean;
|
|
function AsString: string;
|
|
procedure Assign(Source: TPersistent); override;
|
|
published
|
|
property Title: string read FTitle write FTitle;
|
|
property HelpType: THelpNodeType read FHelpType write FHelpType;
|
|
property URL: string read FURL write FURL;
|
|
property ID: string read fID write fID;
|
|
property Context: THelpContext read FContext write FContext;
|
|
end;
|
|
|
|
|
|
{ THelpNodeQuery }
|
|
|
|
THelpNodeQuery = class
|
|
private
|
|
FNode: THelpNode;
|
|
FQueryItem: THelpQueryItem;
|
|
public
|
|
constructor Create;
|
|
constructor Create(TheNode: THelpNode; TheQueryItem: THelpQueryItem);
|
|
function IsEqual(TheNode: THelpNode; TheQueryItem: THelpQueryItem): boolean;
|
|
function IsEqual(NodeQuery: THelpNodeQuery): boolean;
|
|
function AsString: string;
|
|
property Node: THelpNode read FNode write FNode;
|
|
property QueryItem: THelpQueryItem read FQueryItem write FQueryItem;
|
|
end;
|
|
|
|
|
|
{ THelpNodeQueryList }
|
|
|
|
THelpNodeQueryList = class
|
|
private
|
|
fItems: TFPList;
|
|
function GetItems(Index: integer): THelpNodeQuery;
|
|
procedure SetItems(Index: integer; const AValue: THelpNodeQuery);
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function Count: integer;
|
|
function Add(NodeQuery: THelpNodeQuery): integer;
|
|
function Add(Node: THelpNode; QueryItem: THelpQueryItem): integer;
|
|
procedure Delete(Index: integer);
|
|
function IndexOf(NodeQuery: THelpNodeQuery): integer;
|
|
function IndexOf(Node: THelpNode; QueryItem: THelpQueryItem): integer;
|
|
procedure Clear;
|
|
property Items[Index: integer]: THelpNodeQuery read GetItems write SetItems; default;
|
|
end;
|
|
|
|
|
|
{ THelpDBItem
|
|
Base class for registration items associated with a THelpDatabase.
|
|
See THelpDBSISourceDirectory for an example.
|
|
Node is optional, pointing to a help page about the help item. }
|
|
|
|
THelpDBItem = class(TPersistent)
|
|
private
|
|
FNode: THelpNode;
|
|
public
|
|
constructor Create(TheNode: THelpNode);
|
|
destructor Destroy; override;
|
|
published
|
|
property Node: THelpNode read FNode write FNode;
|
|
end;
|
|
|
|
|
|
{ THelpDBSISourceFile
|
|
Help registration item for a single source file.
|
|
If Filename is relative, the BasePathObject is used to get a base directory.
|
|
|
|
For example: If BasePathObject is a TLazPackage the Filename is relative to
|
|
the directory of the .lpk file }
|
|
|
|
THelpDBISourceFile = class(THelpDBItem)
|
|
private
|
|
FBasePathObject: TObject;
|
|
FFilename: string;
|
|
procedure SetFilename(const AValue: string);
|
|
public
|
|
constructor Create(TheNode: THelpNode; const TheFilename: string);
|
|
function FileMatches(const AFilename: string): boolean; virtual;
|
|
function GetFullFilename: string; virtual;
|
|
function GetBasePath: string; virtual;
|
|
published
|
|
property BasePathObject: TObject read FBasePathObject write FBasePathObject;
|
|
property Filename: string read FFilename write SetFilename;
|
|
end;
|
|
|
|
|
|
{ THelpDBISourceDirectory
|
|
Help registration item for a source directory.
|
|
As THelpDBISourceFile, except that Filename is a directory and
|
|
the item is valid for all source files fitting the FileMask.
|
|
FileMask can be for example '*.pp;*.pas;*.inc'
|
|
|
|
For example: A package providing help for all its source files registers
|
|
a THelpDBISourceDirectory. Node points to the fpdoc main page.
|
|
}
|
|
|
|
THelpDBISourceDirectory = class(THelpDBISourceFile)
|
|
private
|
|
FFileMask: string;
|
|
FWithSubDirectories: boolean;
|
|
public
|
|
constructor Create(TheNode: THelpNode; const TheFilename,
|
|
TheFileMask: string; Recursive: boolean);
|
|
function FileMatches(const AFilename: string): boolean; override;
|
|
published
|
|
property FileMask: string read FFileMask write FFileMask;
|
|
property WithSubDirectories: boolean read FWithSubDirectories
|
|
write FWithSubDirectories;
|
|
end;
|
|
|
|
|
|
{ THelpDBIClass
|
|
Help registration item for a class.
|
|
Used by the IDE to search for help for a class without source.
|
|
For example for a registered component class in the component palette, that
|
|
comes without source. If the component comes with source use the
|
|
THelpDBISourceDirectory or THelpDBISourceFile instead. }
|
|
|
|
THelpDBIClass = class(THelpDBItem)
|
|
private
|
|
FTheClass: TClass;
|
|
public
|
|
property TheClass: TClass read FTheClass write FTheClass;
|
|
end;
|
|
|
|
|
|
{ THelpDBIMessage
|
|
Help registration item for a message (e.g. a fpc warning).
|
|
Used by the IDE to search for help for one message (typically a line).
|
|
For example a line like
|
|
"/usr/share/lazarus/components/synedit/syneditkeycmds.pp(532,10) Warning: Function result does not seem to be set"
|
|
}
|
|
|
|
THelpDBIMessage = class(THelpDBItem)
|
|
public
|
|
function MessageMatches(const TheMessage: string; MessageParts: TStrings
|
|
): boolean; virtual; abstract;
|
|
end;
|
|
|
|
|
|
{ THelpQueryNode }
|
|
|
|
THelpQueryNode = class(THelpQuery)
|
|
private
|
|
FNode: THelpNode;
|
|
public
|
|
constructor Create(const TheHelpDatabaseID: THelpDatabaseID;
|
|
const TheNode: THelpNode);
|
|
property Node: THelpNode read FNode write FNode;
|
|
end;
|
|
|
|
|
|
{ THelpDatabase
|
|
Base class for a collection of help files or entries.
|
|
BasePathObject: THelpDatabase can be created by packages.
|
|
The IDE will set BasePathObject accordingly. }
|
|
|
|
THelpDatabases = class;
|
|
THelpViewer = class;
|
|
|
|
THelpDatabase = class(TComponent)
|
|
private
|
|
FAutoRegister: boolean;
|
|
FBasePathObject: TObject;
|
|
FID: THelpDatabaseID;
|
|
FDatabases: THelpDatabases;
|
|
FRefCount: integer;
|
|
FSearchItems: TFPList;
|
|
FSupportedMimeTypes: TStrings;
|
|
FTOCNode: THelpNode;
|
|
procedure SetAutoRegister(const AValue: boolean);
|
|
procedure SetID(const AValue: THelpDatabaseID);
|
|
procedure SetDatabases(const AValue: THelpDatabases);
|
|
protected
|
|
procedure SetSupportedMimeTypes(List: TStrings); virtual;
|
|
procedure AddSupportedMimeType(const AMimeType: string); virtual;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Reference;
|
|
procedure RegisterSelf;
|
|
procedure Release;
|
|
procedure UnregisterSelf;
|
|
function Registered: boolean;
|
|
function CanShowTableOfContents: boolean; virtual;
|
|
procedure ShowTableOfContents; virtual;
|
|
procedure ShowError(ShowResult: TShowHelpResult; const ErrMsg: string); virtual;
|
|
function ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode;
|
|
QueryItem: THelpQueryItem;
|
|
var ErrMsg: string): TShowHelpResult; virtual;
|
|
function ShowHelpFile(Query: THelpQuery; BaseNode: THelpNode;
|
|
const Title, Filename: string;
|
|
var ErrMsg: string): TShowHelpResult; virtual;
|
|
function SupportsMimeType(const AMimeType: string): boolean; virtual;
|
|
function GetNodesForKeyword(const HelpKeyword: string;
|
|
var ListOfNodes: THelpNodeQueryList;
|
|
var ErrMsg: string): TShowHelpResult; virtual;
|
|
function GetNodesForContext(HelpContext: THelpContext;
|
|
var ListOfNodes: THelpNodeQueryList;
|
|
var ErrMsg: string): TShowHelpResult; virtual;
|
|
function GetNodesForPascalContexts(ListOfPascalHelpContextList: TList;
|
|
var ListOfNodes: THelpNodeQueryList;
|
|
var ErrMsg: string): TShowHelpResult; virtual;
|
|
function GetNodesForClass(AClass: TClass;
|
|
var ListOfNodes: THelpNodeQueryList;
|
|
var ErrMsg: string): TShowHelpResult; virtual;
|
|
function GetNodesForMessage(const AMessage: string; MessageParts: TStrings;
|
|
var ListOfNodes: THelpNodeQueryList;
|
|
var ErrMsg: string): TShowHelpResult; virtual;
|
|
function FindViewer(const MimeType: string; var ErrMsg: string;
|
|
out Viewer: THelpViewer): TShowHelpResult; virtual;
|
|
public
|
|
// registration
|
|
procedure RegisterItem(NewItem: THelpDBItem);
|
|
procedure RegisterItemWithNode(Node: THelpNode);
|
|
procedure RegisterFileItemWithNode(const Filename: string; Node: THelpNode);
|
|
procedure UnregisterItem(AnItem: THelpDBItem);
|
|
function RegisteredItemCount: integer;
|
|
function GetRegisteredItem(Index: integer): THelpDBItem;
|
|
procedure Load(Storage: TConfigStorage); virtual;
|
|
procedure Save(Storage: TConfigStorage); virtual;
|
|
function GetLocalizedName: string; virtual;
|
|
public
|
|
property Databases: THelpDatabases read FDatabases write SetDatabases;
|
|
property ID: THelpDatabaseID read FID write SetID;
|
|
property SupportedMimeTypes: TStrings read FSupportedMimeTypes;
|
|
property BasePathObject: TObject read FBasePathObject write FBasePathObject;
|
|
property TOCNode: THelpNode read FTOCNode write FTOCNode;
|
|
property AutoRegister: boolean read FAutoRegister write SetAutoRegister;
|
|
end;
|
|
|
|
THelpDatabaseClass = class of THelpDatabase;
|
|
|
|
|
|
{ THelpDatabases
|
|
Class for storing all registered THelpDatabase(s) }
|
|
|
|
THelpDatabases = class(THelpManager)
|
|
private
|
|
FItems: TFPList;
|
|
FHelpDBClasses: TFPList;
|
|
function GetItems(Index: integer): THelpDatabase;
|
|
procedure DoRegisterDatabase(ADatabase: THelpDatabase);
|
|
procedure DoUnregisterDatabase(ADatabase: THelpDatabase);
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function Count: integer;
|
|
property Items[Index: integer]: THelpDatabase read GetItems; default;
|
|
public
|
|
function FindDatabase(ID: THelpDatabaseID): THelpDatabase;
|
|
function GetDatabase(ID: THelpDatabaseID; var HelpDB: THelpDatabase;
|
|
var HelpResult: TShowHelpResult; var ErrMsg: string): boolean;
|
|
function IndexOf(ID: THelpDatabaseID): integer;
|
|
function CreateUniqueDatabaseID(const WishID: string): THelpDatabaseID;
|
|
function CreateHelpDatabase(const WishID: string;
|
|
HelpDataBaseClass: THelpDatabaseClass;
|
|
AutoRegister: boolean): THelpDatabase;
|
|
function ShowTableOfContents(var ErrMsg: string): TShowHelpResult; override;
|
|
procedure ShowError(ShowResult: TShowHelpResult; const ErrMsg: string); override;
|
|
function GetBaseURLForBasePathObject(BasePathObject: TObject): string; virtual;
|
|
function GetBaseDirectoryForBasePathObject(BasePathObject: TObject): string; virtual;
|
|
function FindViewer(const MimeType: string; var ErrMsg: string;
|
|
var Viewer: THelpViewer): TShowHelpResult; virtual;
|
|
function SubstituteMacros(var s: string): boolean; virtual;
|
|
public
|
|
// show help for ...
|
|
function ShowHelpForNodes(Query: THelpQuery; Nodes: THelpNodeQueryList;
|
|
var ErrMsg: string): TShowHelpResult; virtual;
|
|
function ShowHelpForQuery(Query: THelpQuery; AutoFreeQuery: boolean;
|
|
var ErrMsg: string): TShowHelpResult; override;
|
|
function ShowHelpForContext(Query: THelpQueryContext;
|
|
var ErrMsg: string): TShowHelpResult; override;
|
|
function ShowHelpForKeyword(Query: THelpQueryKeyword;
|
|
var ErrMsg: string): TShowHelpResult; override;
|
|
function ShowHelpForPascalContexts(Query: THelpQueryPascalContexts;
|
|
var ErrMsg: string): TShowHelpResult; override;
|
|
function ShowHelpForSourcePosition(Query: THelpQuerySourcePosition;
|
|
var ErrMsg: string): TShowHelpResult; override;
|
|
function ShowHelpForMessageLine(Query: THelpQueryMessage;
|
|
var ErrMsg: string): TShowHelpResult; override;
|
|
function ShowHelpForClass(Query: THelpQueryClass;
|
|
var ErrMsg: string): TShowHelpResult; override;
|
|
function ShowHelpFile(const Filename, Title, MimeType: string;
|
|
var ErrMsg: string): TShowHelpResult; override;
|
|
function ShowHelp(const URL, Title, MimeType: string;
|
|
var ErrMsg: string): TShowHelpResult; override;
|
|
// search registered items in all databases
|
|
function GetNodesForKeyword(const HelpKeyword: string;
|
|
var ListOfNodes: THelpNodeQueryList;
|
|
var ErrMsg: string): TShowHelpResult; virtual;
|
|
function GetNodesForContext(HelpContext: THelpContext;
|
|
var ListOfNodes: THelpNodeQueryList;
|
|
var ErrMsg: string): TShowHelpResult; virtual;
|
|
function GetNodesForPascalContexts(ListOfPascalHelpContextList: TList;
|
|
var ListOfNodes: THelpNodeQueryList;
|
|
var ErrMsg: string): TShowHelpResult; virtual;
|
|
function GetNodesForClass(AClass: TClass;
|
|
var ListOfNodes: THelpNodeQueryList;
|
|
var ErrMsg: string): TShowHelpResult; virtual;
|
|
function GetNodesForMessage(const AMessage: string; MessageParts: TStrings;
|
|
var ListOfNodes: THelpNodeQueryList;
|
|
var ErrMsg: string): TShowHelpResult; virtual;
|
|
// Show the help selector
|
|
function ShowHelpSelector(Query: THelpQuery; Nodes: THelpNodeQueryList;
|
|
var ErrMsg: string;
|
|
var Selection: THelpNodeQuery
|
|
): TShowHelpResult; virtual;
|
|
public
|
|
// registration of THelpDatabaseClass
|
|
procedure RegisterHelpDatabaseClass(NewHelpDB: THelpDatabaseClass);
|
|
procedure UnregisterHelpDatabaseClass(AHelpDB: THelpDatabaseClass);
|
|
function HelpDatabaseClassCount: integer;
|
|
function GetHelpDatabaseClass(Index: integer): THelpDatabaseClass;
|
|
procedure Load(Storage: TConfigStorage); virtual;
|
|
procedure Save(Storage: TConfigStorage); virtual;
|
|
end;
|
|
|
|
|
|
{ THelpViewer
|
|
base class for all Help viewers }
|
|
|
|
THelpViewer = class(TComponent)
|
|
private
|
|
FAutoRegister: boolean;
|
|
FParameterHelp: string;
|
|
FStorageName: string;
|
|
FSupportedMimeTypes: TStrings;
|
|
procedure SetAutoRegister(const AValue: boolean);
|
|
protected
|
|
procedure SetSupportedMimeTypes(List: TStrings); virtual;
|
|
procedure AddSupportedMimeType(const AMimeType: string); virtual;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function SupportsTableOfContents: boolean; virtual;
|
|
procedure ShowTableOfContents(Node: THelpNode); virtual;
|
|
function SupportsMimeType(const AMimeType: string): boolean; virtual;
|
|
function ShowNode(Node: THelpNode; var ErrMsg: string): TShowHelpResult; virtual;
|
|
procedure Hide; virtual;
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure Load(Storage: TConfigStorage); virtual;
|
|
procedure Save(Storage: TConfigStorage); virtual;
|
|
function GetLocalizedName: string; virtual;
|
|
procedure RegisterSelf; virtual;
|
|
procedure UnregisterSelf; virtual;
|
|
public
|
|
property SupportedMimeTypes: TStrings read FSupportedMimeTypes;
|
|
property ParameterHelp: string read FParameterHelp write FParameterHelp;
|
|
property StorageName: string read FStorageName write FStorageName;
|
|
property AutoRegister: boolean read FAutoRegister write SetAutoRegister;
|
|
end;
|
|
|
|
THelpViewerClass = class of THelpViewer;
|
|
|
|
|
|
{ THelpViewers }
|
|
|
|
THelpViewers = class
|
|
private
|
|
FItems: TFPList;
|
|
FDestroying: boolean;
|
|
function GetItems(Index: integer): THelpViewer;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
function Count: integer;
|
|
function GetViewersSupportingMimeType(const MimeType: string): TList;
|
|
procedure RegisterViewer(AHelpViewer: THelpViewer);
|
|
procedure UnregisterViewer(AHelpViewer: THelpViewer);
|
|
procedure Load(Storage: TConfigStorage); virtual;
|
|
procedure Save(Storage: TConfigStorage); virtual;
|
|
function IndexOf(AHelpViewer: THelpViewer): integer;
|
|
public
|
|
property Items[Index: integer]: THelpViewer read GetItems; default;
|
|
end;
|
|
|
|
|
|
{ THelpBasePathObject
|
|
Simple class to store a base file path for help databases. }
|
|
|
|
THelpBasePathObject = class(TPersistent)
|
|
private
|
|
FBasePath: string;
|
|
protected
|
|
procedure SetBasePath(const AValue: string); virtual;
|
|
public
|
|
constructor Create;
|
|
constructor Create(const TheBasePath: string);
|
|
property BasePath: string read FBasePath write SetBasePath;
|
|
end;
|
|
|
|
{ THelpBaseURLObject
|
|
Simple class to store a base URL path for help databases. }
|
|
|
|
THelpBaseURLObject = class(TPersistent)
|
|
private
|
|
FBaseURL: string;
|
|
protected
|
|
procedure SetBaseURL(const AValue: string);
|
|
public
|
|
constructor Create;
|
|
constructor Create(const TheBaseURL: string);
|
|
property BaseURL: string read FBaseURL write SetBaseURL;
|
|
end;
|
|
|
|
var
|
|
HelpDatabases: THelpDatabases = nil; // initialized by the IDE
|
|
HelpViewers: THelpViewers = nil; // initialized by the IDE
|
|
|
|
procedure CreateLCLHelpSystem;
|
|
procedure FreeLCLHelpSystem;
|
|
procedure FreeUnusedLCLHelpSystem;
|
|
|
|
// URL functions
|
|
// used names:
|
|
// URL: Type + Path + Params e.g. http://www.freepascal.org?param
|
|
// URLType: e.g. file or http
|
|
// URLPath: URL without type and without parameters (always / as path delimiter)
|
|
// URLParams: parameters appended by ? or #
|
|
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;
|
|
function URLFilenameIsAbsolute(const URLPath: string): boolean;
|
|
function FindURLPathStart(const URL: string): integer;
|
|
function FindURLPathEnd(const URL: string): integer;
|
|
function ChompURLParams(const URL: string): string;
|
|
function ExtractURLPath(const URL: string): string;
|
|
function ExtractURLDirectory(const URL: string): string;
|
|
function TrimUrl(const URL: string): string;
|
|
function TrimURLPath(const URLPath: string): string;
|
|
function IsFileURL(const URL: string): boolean;
|
|
function AppendURLPathDelim(const URLPath: string): string;
|
|
|
|
procedure CreateListAndAdd(const AnObject: TObject; var List: TList;
|
|
OnlyIfNotExists: boolean);
|
|
procedure CreateNodeQueryListAndAdd(const ANode: THelpNode;
|
|
const QueryItem: THelpQueryItem;
|
|
var List: THelpNodeQueryList; OnlyIfNotExists: boolean);
|
|
|
|
|
|
implementation
|
|
|
|
|
|
procedure CreateLCLHelpSystem;
|
|
begin
|
|
if (HelpDatabases<>nil) or (HelpManager<>nil) then exit;
|
|
HelpDatabases:=THelpDatabases.Create;
|
|
HelpManager:=HelpDatabases;
|
|
HelpViewers:=THelpViewers.Create;
|
|
end;
|
|
|
|
procedure FreeLCLHelpSystem;
|
|
begin
|
|
FreeThenNil(HelpDatabases);
|
|
FreeThenNil(HelpViewers);
|
|
HelpManager:=nil;
|
|
end;
|
|
|
|
procedure FreeUnusedLCLHelpSystem;
|
|
begin
|
|
if (HelpViewers<>nil) and (HelpViewers.Count>0) then exit;
|
|
if (HelpDatabases<>nil) and (HelpDatabases.Count>0) then exit;
|
|
FreeLCLHelpSystem;
|
|
end;
|
|
|
|
function FilenameToURL(const Filename: string): string;
|
|
begin
|
|
Result:=FilenameToURLPath(Filename);
|
|
if Result<>'' then
|
|
Result:='file://'+Result;
|
|
end;
|
|
|
|
function FilenameToURLPath(const Filename: string): string;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result:=Filename;
|
|
{$warnings off}
|
|
if PathDelim<>'/' then
|
|
for i:=1 to length(Result) do
|
|
if Result[i]=PathDelim then
|
|
Result[i]:='/';
|
|
{$warnings on}
|
|
end;
|
|
|
|
function URLPathToFilename(const URLPath: string): string;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result:=URLPath;
|
|
{$warnings off}
|
|
if PathDelim<>'/' then
|
|
for i:=1 to length(Result) do
|
|
if Result[i]='/' then
|
|
Result[i]:=PathDelim;
|
|
{$warnings on}
|
|
end;
|
|
|
|
procedure SplitURL(const URL: string; out URLType, URLPath, URLParams: string);
|
|
var
|
|
Len: Integer;
|
|
ColonPos: Integer;
|
|
ParamStartPos: integer;
|
|
URLStartPos: Integer;
|
|
begin
|
|
URLType:='';
|
|
URLPath:='';
|
|
URLParams:='';
|
|
Len:=length(URL);
|
|
// search colon
|
|
ColonPos:=1;
|
|
while (ColonPos<=len) and (URL[ColonPos]<>':') do
|
|
inc(ColonPos);
|
|
if ColonPos>len then exit;
|
|
// get URLType
|
|
URLType:=copy(URL,1,ColonPos-1);
|
|
URLStartPos:=ColonPos+1;
|
|
// skip the '//' after the colon
|
|
if (URLStartPos<=len) and (URL[URLStartPos]='/') then inc(URLStartPos);
|
|
if (URLStartPos<=len) and (URL[URLStartPos]='/') then inc(URLStartPos);
|
|
// search for param delimiter (?) or anchor delimiter (#)
|
|
ParamStartPos:=ColonPos+1;
|
|
while (ParamStartPos<=len) and not (URL[ParamStartPos]in ['?', '#']) do
|
|
inc(ParamStartPos);
|
|
// get URLPath and URLParams
|
|
URLPath:=copy(URL,URLStartPos,ParamStartPos-URLStartPos);
|
|
URLParams:=copy(URL,ParamStartPos,len-ParamStartPos+1);
|
|
end;
|
|
|
|
function CombineURL(const URLType, URLPath, URLParams: string): string;
|
|
begin
|
|
Result:=URLType+'://'+URLPath;
|
|
if URLParams<>'' then
|
|
Result:=Result+URLParams;
|
|
end;
|
|
|
|
function URLFilenameIsAbsolute(const URLPath: string): boolean;
|
|
begin
|
|
Result:=FilenameIsAbsolute(URLPathToFilename(URLPath));
|
|
end;
|
|
|
|
function FindURLPathStart(const URL: string): integer;
|
|
var
|
|
Len: Integer;
|
|
ColonPos: Integer;
|
|
URLStartPos: Integer;
|
|
begin
|
|
Result:=-1;
|
|
Len:=length(URL);
|
|
// search colon
|
|
ColonPos:=1;
|
|
while (ColonPos<=len) and (URL[ColonPos]<>':') do
|
|
inc(ColonPos);
|
|
if ColonPos=Len then exit;
|
|
URLStartPos:=ColonPos+1;
|
|
// skip the '//' after the colon
|
|
if (URLStartPos<=Len) and (URL[URLStartPos]='/') then inc(URLStartPos);
|
|
if (URLStartPos<=Len) and (URL[URLStartPos]='/') then inc(URLStartPos);
|
|
Result:=URLStartPos;
|
|
end;
|
|
|
|
function FindURLPathEnd(const URL: string): integer;
|
|
var
|
|
Len: Integer;
|
|
begin
|
|
Result:=1;
|
|
Len:=length(URL);
|
|
while (Result<=Len) and not (URL[Result] in ['?','#']) do inc(Result);
|
|
end;
|
|
|
|
function ChompURLParams(const URL: string): string;
|
|
begin
|
|
Result:=copy(URL,1,FindURLPathEnd(URL)-1);
|
|
end;
|
|
|
|
function ExtractURLDirectory(const URL: string): string;
|
|
var
|
|
p: Integer;
|
|
PathStart: LongInt;
|
|
begin
|
|
Result:='';
|
|
PathStart:=FindURLPathStart(URL);
|
|
if PathStart<1 then exit;
|
|
p:=FindURLPathEnd(URL);
|
|
repeat
|
|
dec(p);
|
|
until (p<=0) or (URL[p]='/');
|
|
if p<=PathStart then exit;
|
|
Result:=copy(URL,1,p);
|
|
end;
|
|
|
|
function TrimUrl(const URL: string): string;
|
|
var
|
|
URLType, URLPath, URLParams: string;
|
|
begin
|
|
SplitURL(URL,URLType,URLPath,URLParams);
|
|
Result:=CombineURL(URLType,TrimURLPath(URLPath),URLParams);
|
|
end;
|
|
|
|
function TrimURLPath(const URLPath: string): string;
|
|
begin
|
|
Result:=FilenameToURLPath(TrimFilename(URLPathToFilename(URLPath)));
|
|
end;
|
|
|
|
function IsFileURL(const URL: string): boolean;
|
|
begin
|
|
Result:=(length(URL)>=7)
|
|
and (CompareByte(URL[1],'file://',7)=0);
|
|
end;
|
|
|
|
function AppendURLPathDelim(const URLPath: string): string;
|
|
begin
|
|
if (URLPath<>'') and (URLPath[length(URLPath)]<>'/') then
|
|
Result:=URLPath+'/'
|
|
else
|
|
Result:=URLPath;
|
|
end;
|
|
|
|
function ExtractURLPath(const URL: string): string;
|
|
var
|
|
URLType, URLPath, URLParams: string;
|
|
begin
|
|
SplitURL(URL,URLType,URLPath,URLParams);
|
|
Result:=URLPath;
|
|
end;
|
|
|
|
procedure CreateListAndAdd(const AnObject: TObject; var List: TList;
|
|
OnlyIfNotExists: boolean);
|
|
begin
|
|
if List=nil then
|
|
List:=TList.Create
|
|
else if OnlyIfNotExists and (List.IndexOf(AnObject)>=0) then
|
|
exit;
|
|
List.Add(AnObject);
|
|
end;
|
|
|
|
procedure CreateNodeQueryListAndAdd(const ANode: THelpNode;
|
|
const QueryItem: THelpQueryItem;
|
|
var List: THelpNodeQueryList; OnlyIfNotExists: boolean);
|
|
begin
|
|
if List=nil then
|
|
List:=THelpNodeQueryList.Create
|
|
else if OnlyIfNotExists and (List.IndexOf(ANode,QueryItem)>=0) then
|
|
exit;
|
|
List.Add(ANode,QueryItem);
|
|
end;
|
|
|
|
|
|
|
|
{ THelpDatabase }
|
|
|
|
procedure THelpDatabase.SetID(const AValue: THelpDatabaseID);
|
|
var
|
|
OldRegistered: Boolean;
|
|
begin
|
|
if FID=AValue then exit;
|
|
OldRegistered:=Registered;
|
|
if OldRegistered then UnregisterSelf;
|
|
FID:=AValue;
|
|
if OldRegistered then RegisterSelf;
|
|
end;
|
|
|
|
procedure THelpDatabase.SetAutoRegister(const AValue: boolean);
|
|
begin
|
|
if FAutoRegister=AValue then exit;
|
|
FAutoRegister:=AValue;
|
|
if not (csDesigning in ComponentState) then begin
|
|
if FAutoRegister then begin
|
|
if FID='' then
|
|
FID:=Name;
|
|
if Databases=nil then RegisterSelf;
|
|
end else begin
|
|
if Databases<>nil then UnregisterSelf;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure THelpDatabase.SetDatabases(const AValue: THelpDatabases);
|
|
begin
|
|
if AValue=Databases then exit;
|
|
Reference;
|
|
if FDatabases<>nil then FDatabases.DoUnregisterDatabase(Self);
|
|
FDatabases:=AValue;
|
|
if FDatabases<>nil then FDatabases.DoRegisterDatabase(Self);
|
|
Release;
|
|
end;
|
|
|
|
procedure THelpDatabase.SetSupportedMimeTypes(List: TStrings);
|
|
begin
|
|
FSupportedMimeTypes.Free;
|
|
FSupportedMimeTypes:=List;
|
|
end;
|
|
|
|
procedure THelpDatabase.AddSupportedMimeType(const AMimeType: string);
|
|
begin
|
|
if FSupportedMimeTypes=nil then SetSupportedMimeTypes(TStringList.Create);
|
|
FSupportedMimeTypes.Add(AMimeType);
|
|
end;
|
|
|
|
constructor THelpDatabase.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
end;
|
|
|
|
destructor THelpDatabase.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Reference; // reference to not call Free again
|
|
if Databases<>nil then UnregisterSelf;
|
|
FSupportedMimeTypes.Free;
|
|
if FSearchItems<>nil then begin
|
|
for i:=FSearchItems.Count-1 downto 0 do
|
|
THelpNode(FSearchItems[i]).Free;
|
|
FSearchItems.Free;
|
|
end;
|
|
FTOCNode.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure THelpDatabase.RegisterSelf;
|
|
begin
|
|
if Databases<>nil then
|
|
raise EHelpSystemException.Create(Format(rsHelpAlreadyRegistered, [ID]));
|
|
if HelpDatabases=nil then CreateLCLHelpSystem;
|
|
Databases:=HelpDatabases;
|
|
end;
|
|
|
|
procedure THelpDatabase.UnregisterSelf;
|
|
begin
|
|
if Databases=nil then
|
|
raise EHelpSystemException.Create(Format(rsHelpNotRegistered, [ID]));
|
|
Databases:=nil;
|
|
FreeUnusedLCLHelpSystem;
|
|
end;
|
|
|
|
function THelpDatabase.Registered: boolean;
|
|
begin
|
|
Result:=Databases<>nil;
|
|
end;
|
|
|
|
function THelpDatabase.CanShowTableOfContents: boolean;
|
|
begin
|
|
Result:=TOCNode<>nil;
|
|
end;
|
|
|
|
procedure THelpDatabase.ShowTableOfContents;
|
|
var
|
|
ErrMsg: string;
|
|
ShowResult: TShowHelpResult;
|
|
Query: THelpQueryTOC;
|
|
begin
|
|
if TOCNode=nil then exit;
|
|
ErrMsg:='';
|
|
Query:=THelpQueryTOC.Create(ID);
|
|
try
|
|
ShowResult:=ShowHelp(Query,nil,TOCNode,nil,ErrMsg);
|
|
finally
|
|
Query.Free;
|
|
end;
|
|
ShowError(ShowResult,ErrMsg);
|
|
end;
|
|
|
|
procedure THelpDatabase.ShowError(ShowResult: TShowHelpResult;
|
|
const ErrMsg: string);
|
|
begin
|
|
if ShowResult=shrSuccess then exit;
|
|
if Databases<>nil then
|
|
Databases.ShowError(ShowResult,ErrMsg)
|
|
else
|
|
raise EHelpSystemException.Create(ErrMsg);
|
|
end;
|
|
|
|
function THelpDatabase.ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode;
|
|
QueryItem: THelpQueryItem; var ErrMsg: string): TShowHelpResult;
|
|
begin
|
|
ErrMsg:='';
|
|
Result:=shrContextNotFound;
|
|
end;
|
|
|
|
function THelpDatabase.ShowHelpFile(Query: THelpQuery; BaseNode: THelpNode;
|
|
const Title, Filename: string; var ErrMsg: string): TShowHelpResult;
|
|
var
|
|
FileNode: THelpNode;
|
|
begin
|
|
FileNode:=THelpNode.CreateURL(Self,Title,FilenameToURL(Filename));
|
|
try
|
|
Result:=ShowHelp(Query,BaseNode,FileNode,nil,ErrMsg);
|
|
finally
|
|
FileNode.Free;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabase.SupportsMimeType(const AMimeType: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
if FSupportedMimeTypes<>nil then
|
|
Result:=(FSupportedMimeTypes.IndexOf(AMimeType)>=0);
|
|
end;
|
|
|
|
function THelpDatabase.GetNodesForKeyword(const HelpKeyword: string;
|
|
var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
|
|
// if ListOfNodes<>nil new nodes will be appended
|
|
// if ListOfNodes=nil and nodes exists a new list will be created
|
|
var
|
|
i: Integer;
|
|
Node: THelpNode;
|
|
begin
|
|
Result:=shrSuccess;
|
|
ErrMsg:='';
|
|
if csDesigning in ComponentState then exit;
|
|
// add the registered nodes
|
|
if FSearchItems<>nil then begin
|
|
for i:=0 to FSearchItems.Count-1 do begin
|
|
Node:=THelpDBItem(FSearchItems[i]).Node;
|
|
if (Node=nil) or (not Node.IDValid) then continue;
|
|
if AnsiCompareText(Node.ID,HelpKeyword)<>0 then continue;
|
|
CreateNodeQueryListAndAdd(Node,nil,ListOfNodes,true);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabase.GetNodesForContext(HelpContext: THelpContext;
|
|
var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
|
|
// if ListOfNodes<>nil new nodes will be appended
|
|
// if ListOfNodes=nil and nodes exists a new list will be created
|
|
var
|
|
i: Integer;
|
|
Node: THelpNode;
|
|
begin
|
|
Result:=shrSuccess;
|
|
ErrMsg:='';
|
|
if csDesigning in ComponentState then exit;
|
|
// add the registered nodes
|
|
if FSearchItems<>nil then begin
|
|
for i:=0 to FSearchItems.Count-1 do begin
|
|
Node:=THelpDBItem(FSearchItems[i]).Node;
|
|
if (Node=nil) or (not Node.ContextValid) then continue;
|
|
if Node.Context<>HelpContext then continue;
|
|
CreateNodeQueryListAndAdd(Node,nil,ListOfNodes,true);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabase.GetNodesForPascalContexts(
|
|
ListOfPascalHelpContextList: TList; var ListOfNodes: THelpNodeQueryList;
|
|
var ErrMsg: string): TShowHelpResult;
|
|
// if ListOfNodes<>nil new nodes will be appended
|
|
// if ListOfNodes=nil and nodes exists a new list will be created
|
|
var
|
|
i: Integer;
|
|
j: Integer;
|
|
SearchItem: THelpDBItem;
|
|
PascalContext: TPascalHelpContextList;
|
|
FileItem: THelpDBISourceFile;
|
|
Filename: String;
|
|
begin
|
|
Result:=shrSuccess;
|
|
ErrMsg:='';
|
|
if csDesigning in ComponentState then exit;
|
|
if (ListOfPascalHelpContextList=nil)
|
|
or (ListOfPascalHelpContextList.Count=0) then exit;
|
|
// add the registered nodes
|
|
debugln('THelpDatabase.GetNodesForPascalContexts A ID="',ID,'" ListOfPascalHelpContextList.Count=',dbgs(ListOfPascalHelpContextList.Count));
|
|
if FSearchItems<>nil then begin
|
|
// check every pascal context
|
|
for j:=0 to ListOfPascalHelpContextList.Count-1 do begin
|
|
PascalContext:=TPascalHelpContextList(ListOfPascalHelpContextList[j]);
|
|
//debugln('THelpDatabase.GetNodesForPascalContexts A ID="',ID,'" PascalContext.Count=',dbgs(PascalContext.Count));
|
|
if (PascalContext.Count>0)
|
|
and (PascalContext.List[0].Descriptor=pihcFilename) then begin
|
|
Filename:=PascalContext.List[0].Context;
|
|
// search file item
|
|
for i:=0 to FSearchItems.Count-1 do begin
|
|
SearchItem:=THelpDBItem(FSearchItems[i]);
|
|
if not (SearchItem is THelpDBISourceFile) then continue;
|
|
FileItem:=THelpDBISourceFile(SearchItem);
|
|
//debugln('THelpDatabase.GetNodesForPascalContexts B FileItem.ClassName=',FileItem.ClassName,' Filename=',Filename,' FileItem.GetFullFilename="',FileItem.GetFullFilename,'"');
|
|
if (FileItem.FileMatches(Filename)) then begin
|
|
CreateNodeQueryListAndAdd(FileItem.Node,PascalContext,ListOfNodes,true);
|
|
debugln('THelpDatabase.GetNodesForPascalContexts C FileItem.ClassName=',FileItem.ClassName,' Filename=',Filename,' ',dbgs(ListOfNodes.Count));
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabase.GetNodesForClass(AClass: TClass;
|
|
var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
|
|
// if ListOfNodes<>nil new nodes will be appended
|
|
// if ListOfNodes=nil and nodes exists a new list will be created
|
|
var
|
|
i: Integer;
|
|
SearchItem: THelpDBItem;
|
|
begin
|
|
Result:=shrSuccess;
|
|
ErrMsg:='';
|
|
if csDesigning in ComponentState then exit;
|
|
// add the registered nodes
|
|
if FSearchItems<>nil then begin
|
|
for i:=0 to FSearchItems.Count-1 do begin
|
|
SearchItem:=THelpDBItem(FSearchItems[i]);
|
|
if not (SearchItem is THelpDBIClass) then continue;
|
|
if THelpDBIClass(SearchItem).TheClass<>AClass then continue;
|
|
CreateNodeQueryListAndAdd(SearchItem.Node,nil,ListOfNodes,true);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabase.GetNodesForMessage(const AMessage: string;
|
|
MessageParts: TStrings; var ListOfNodes: THelpNodeQueryList;
|
|
var ErrMsg: string): TShowHelpResult;
|
|
// if ListOfNodes<>nil new nodes will be appended
|
|
// if ListOfNodes=nil and nodes exists a new list will be created
|
|
var
|
|
i: Integer;
|
|
SearchItem: THelpDBItem;
|
|
begin
|
|
Result:=shrSuccess;
|
|
ErrMsg:='';
|
|
if csDesigning in ComponentState then exit;
|
|
// add the registered nodes
|
|
if FSearchItems<>nil then begin
|
|
for i:=0 to FSearchItems.Count-1 do begin
|
|
SearchItem:=THelpDBItem(FSearchItems[i]);
|
|
if not (SearchItem is THelpDBIMessage) then continue;
|
|
if not THelpDBIMessage(SearchItem).MessageMatches(AMessage,MessageParts)
|
|
then continue;
|
|
CreateNodeQueryListAndAdd(SearchItem.Node,nil,ListOfNodes,true);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabase.FindViewer(const MimeType: string; var ErrMsg: string;
|
|
out Viewer: THelpViewer): TShowHelpResult;
|
|
var
|
|
Viewers: TList;
|
|
begin
|
|
Viewer:=nil;
|
|
Viewers:=HelpViewers.GetViewersSupportingMimeType(MimeType);
|
|
try
|
|
if (Viewers=nil) or (Viewers.Count=0) then begin
|
|
ErrMsg:=Format(rsHelpHelpDatabaseDidNotFoundAViewerForAHelpPageOfType, [
|
|
'"', ID, '"', MimeType]);
|
|
Result:=shrViewerNotFound;
|
|
end else begin
|
|
Viewer:=THelpViewer(Viewers[0]);
|
|
Result:=shrSuccess;
|
|
end;
|
|
finally
|
|
Viewers.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure THelpDatabase.RegisterItem(NewItem: THelpDBItem);
|
|
begin
|
|
if NewItem=nil then
|
|
raise EHelpSystemException.Create('THelpDatabase.RegisterItem NewItem=nil');
|
|
if FSearchItems=nil then FSearchItems:=TFPList.Create;
|
|
if FSearchItems.IndexOf(NewItem)<0 then
|
|
FSearchItems.Add(NewItem)
|
|
else
|
|
NewItem.Free;
|
|
end;
|
|
|
|
procedure THelpDatabase.RegisterItemWithNode(Node: THelpNode);
|
|
begin
|
|
if Node=nil then
|
|
raise EHelpSystemException.Create('THelpDatabase.RegisterItemWithNode Node=nil');
|
|
RegisterItem(THelpDBItem.Create(Node));
|
|
end;
|
|
|
|
procedure THelpDatabase.RegisterFileItemWithNode(const Filename: string;
|
|
Node: THelpNode);
|
|
begin
|
|
RegisterItem(THelpDBISourceFile.Create(Node,Filename));
|
|
end;
|
|
|
|
procedure THelpDatabase.UnregisterItem(AnItem: THelpDBItem);
|
|
begin
|
|
if FSearchItems=nil then exit;
|
|
FSearchItems.Remove(AnItem);
|
|
end;
|
|
|
|
function THelpDatabase.RegisteredItemCount: integer;
|
|
begin
|
|
if FSearchItems=nil then
|
|
Result:=0
|
|
else
|
|
Result:=FSearchItems.Count;
|
|
end;
|
|
|
|
function THelpDatabase.GetRegisteredItem(Index: integer): THelpDBItem;
|
|
begin
|
|
Result:=THelpDBItem(FSearchItems[Index]);
|
|
end;
|
|
|
|
procedure THelpDatabase.Load(Storage: TConfigStorage);
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure THelpDatabase.Save(Storage: TConfigStorage);
|
|
begin
|
|
|
|
end;
|
|
|
|
function THelpDatabase.GetLocalizedName: string;
|
|
begin
|
|
Result:=ID;
|
|
end;
|
|
|
|
procedure THelpDatabase.Reference;
|
|
begin
|
|
inc(FRefCount);
|
|
end;
|
|
|
|
procedure THelpDatabase.Release;
|
|
begin
|
|
if FRefCount=0 then
|
|
raise EHelpSystemException.Create('THelpDatabase.Release');
|
|
dec(FRefCount);
|
|
if FRefCount=0 then Free;
|
|
end;
|
|
|
|
{ THelpDatabases }
|
|
|
|
function THelpDatabases.GetItems(Index: integer): THelpDatabase;
|
|
begin
|
|
Result:=THelpDatabase(FItems[Index]);
|
|
end;
|
|
|
|
procedure THelpDatabases.DoRegisterDatabase(ADatabase: THelpDatabase);
|
|
begin
|
|
ADatabase.Reference;
|
|
if FItems=nil then FItems:=TFPList.Create;
|
|
FItems.Add(ADatabase);
|
|
end;
|
|
|
|
procedure THelpDatabases.DoUnregisterDatabase(ADatabase: THelpDatabase);
|
|
begin
|
|
if FItems<>nil then
|
|
FItems.Remove(ADatabase);
|
|
ADatabase.Release;
|
|
end;
|
|
|
|
constructor THelpDatabases.Create;
|
|
begin
|
|
|
|
end;
|
|
|
|
destructor THelpDatabases.Destroy;
|
|
begin
|
|
while (Count>0) do Items[Count-1].UnregisterSelf;
|
|
FItems.Free;
|
|
FHelpDBClasses.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function THelpDatabases.Count: integer;
|
|
begin
|
|
if FItems=nil then
|
|
Result:=0
|
|
else
|
|
Result:=FItems.Count;
|
|
end;
|
|
|
|
function THelpDatabases.FindDatabase(ID: THelpDatabaseID): THelpDatabase;
|
|
var
|
|
Index: LongInt;
|
|
begin
|
|
Index:=IndexOf(ID);
|
|
if Index>=0 then
|
|
Result:=Items[Index]
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function THelpDatabases.GetDatabase(ID: THelpDatabaseID; var HelpDB: THelpDatabase;
|
|
var HelpResult: TShowHelpResult; var ErrMsg: string): boolean;
|
|
begin
|
|
HelpDB:=FindDatabase(ID);
|
|
if HelpDB=nil then begin
|
|
Result:=false;
|
|
HelpResult:=shrDatabaseNotFound;
|
|
ErrMsg:=Format(rsHelpHelpDatabaseNotFound, ['"', ID, '"']);
|
|
end else begin
|
|
HelpResult:=shrSuccess;
|
|
Result:=true;
|
|
ErrMsg:='';
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabases.IndexOf(ID: THelpDatabaseID): integer;
|
|
begin
|
|
Result:=Count-1;
|
|
while (Result>=0) and (AnsiCompareText(ID,Items[Result].ID)<>0) do
|
|
dec(Result);
|
|
end;
|
|
|
|
function THelpDatabases.CreateUniqueDatabaseID(
|
|
const WishID: string): THelpDatabaseID;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if (WishID<>'') and (FindDatabase(WishID)=nil) then begin
|
|
Result:=WishID;
|
|
end else begin
|
|
i:=1;
|
|
repeat
|
|
Result:=WishID+IntToStr(i);
|
|
if FindDatabase(Result)=nil then exit;
|
|
inc(i);
|
|
until false;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabases.CreateHelpDatabase(const WishID: string;
|
|
HelpDataBaseClass: THelpDatabaseClass; AutoRegister: boolean): THelpDatabase;
|
|
begin
|
|
Result:=HelpDataBaseClass.Create(nil);
|
|
Result.FID:=CreateUniqueDatabaseID(WishID);
|
|
if AutoRegister then Result.RegisterSelf;
|
|
end;
|
|
|
|
function THelpDatabases.ShowTableOfContents(var ErrMsg: string
|
|
): TShowHelpResult;
|
|
begin
|
|
Result:=shrHelpNotFound;
|
|
ErrMsg:='THelpDatabases.ShowTableOfContents not implemented';
|
|
// ToDo
|
|
end;
|
|
|
|
procedure THelpDatabases.ShowError(ShowResult: TShowHelpResult;
|
|
const ErrMsg: string);
|
|
var
|
|
ErrorCaption: String;
|
|
begin
|
|
case ShowResult of
|
|
shrNone: ErrorCaption:=rsHelpError;
|
|
shrSuccess: exit;
|
|
shrCancel: exit;
|
|
shrDatabaseNotFound: ErrorCaption:=rsHelpDatabaseNotFound;
|
|
shrContextNotFound: ErrorCaption:=rsHelpContextNotFound;
|
|
shrViewerNotFound: ErrorCaption:=rsHelpViewerNotFound;
|
|
shrHelpNotFound: ErrorCaption:=rsHelpNotFound;
|
|
shrViewerError: ErrorCaption:=rsHelpViewerError;
|
|
shrSelectorError: ErrorCaption:=rsHelpSelectorError;
|
|
else ErrorCaption:=rsUnknownErrorPleaseReportThisBug;
|
|
end;
|
|
MessageDlg(ErrorCaption,ErrMsg,mtError,[mbCancel],0);
|
|
end;
|
|
|
|
function THelpDatabases.GetBaseURLForBasePathObject(BasePathObject: TObject
|
|
): string;
|
|
begin
|
|
// this method will be overriden by the IDE
|
|
// provide some useful defaults:
|
|
if (BasePathObject is THelpBaseURLObject) then begin
|
|
Result:=THelpBaseURLObject(BasePathObject).BaseURL;
|
|
end else begin
|
|
// otherwise fetch a filename
|
|
Result:=GetBaseDirectoryForBasePathObject(BasePathObject);
|
|
if Result='' then exit;
|
|
Result:=FilenameToURL(Result);
|
|
end;
|
|
Result:=AppendURLPathDelim(Result);
|
|
end;
|
|
|
|
function THelpDatabases.GetBaseDirectoryForBasePathObject(
|
|
BasePathObject: TObject): string;
|
|
// returns the base file directory of the BasePathObject
|
|
begin
|
|
if (BasePathObject is THelpBaseURLObject) then begin
|
|
Result:=THelpBaseURLObject(BasePathObject).BaseURL;
|
|
if Result='' then exit;
|
|
if not IsFileURL(Result) then begin
|
|
Result:='';
|
|
exit;
|
|
end;
|
|
Result:=ExtractURLPath(Result);
|
|
end else if (BasePathObject is THelpBasePathObject) then
|
|
Result:=THelpBasePathObject(BasePathObject).BasePath
|
|
else
|
|
Result:='';
|
|
Result:=AppendURLPathDelim(Result);
|
|
end;
|
|
|
|
function THelpDatabases.FindViewer(const MimeType: string; var ErrMsg: string;
|
|
var Viewer: THelpViewer): TShowHelpResult;
|
|
var
|
|
Viewers: TList;
|
|
begin
|
|
Viewer:=nil;
|
|
Viewers:=HelpViewers.GetViewersSupportingMimeType(MimeType);
|
|
try
|
|
if (Viewers=nil) or (Viewers.Count=0) then begin
|
|
ErrMsg:=Format(rsHelpThereIsNoViewerForHelpType, ['"', MimeType, '"']);
|
|
Result:=shrViewerNotFound;
|
|
end else begin
|
|
Viewer:=THelpViewer(Viewers[0]);
|
|
Result:=shrSuccess;
|
|
end;
|
|
finally
|
|
Viewers.Free;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabases.SubstituteMacros(var s: string): boolean;
|
|
begin
|
|
Result:=true;
|
|
end;
|
|
|
|
function THelpDatabases.ShowHelpForNodes(Query: THelpQuery;
|
|
Nodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
|
|
var
|
|
NodeQuery: THelpNodeQuery;
|
|
begin
|
|
// check if several nodes found
|
|
//debugln('THelpDatabases.ShowHelpForNodes A Nodes.Count=',dbgs(Nodes.Count));
|
|
NodeQuery:=nil;
|
|
if (Nodes.Count>1) then begin
|
|
Result:=ShowHelpSelector(Query,Nodes,ErrMsg,NodeQuery);
|
|
if Result<>shrSuccess then exit;
|
|
if NodeQuery=nil then exit;
|
|
end else begin
|
|
NodeQuery:=Nodes[0];
|
|
end;
|
|
|
|
// show node
|
|
if NodeQuery.Node.Owner=nil then begin
|
|
Result:=shrDatabaseNotFound;
|
|
ErrMsg:=Format(rsHelpHelpNodeHasNoHelpDatabase, ['"', NodeQuery.Node.Title, '"']);
|
|
exit;
|
|
end;
|
|
Result:=NodeQuery.Node.Owner.ShowHelp(Query,nil,
|
|
NodeQuery.Node,NodeQuery.QueryItem,ErrMsg);
|
|
end;
|
|
|
|
function THelpDatabases.ShowHelpForQuery(Query: THelpQuery;
|
|
AutoFreeQuery: boolean; var ErrMsg: string): TShowHelpResult;
|
|
begin
|
|
try
|
|
// descendants first
|
|
if Query is THelpQueryPascalContexts then
|
|
Result:=ShowHelpForPascalContexts(THelpQueryPascalContexts(Query),ErrMsg)
|
|
else if Query is THelpQueryTOC then
|
|
Result:=ShowTableOfContents(ErrMsg)
|
|
else if Query is THelpQueryContext then
|
|
Result:=ShowHelpForContext(THelpQueryContext(Query),ErrMsg)
|
|
else if Query is THelpQueryKeyword then
|
|
Result:=ShowHelpForKeyword(THelpQueryKeyword(Query),ErrMsg)
|
|
else if Query is THelpQuerySourcePosition then
|
|
Result:=ShowHelpForSourcePosition(THelpQuerySourcePosition(Query),ErrMsg)
|
|
else if Query is THelpQueryMessage then
|
|
Result:=ShowHelpForMessageLine(THelpQueryMessage(Query),ErrMsg)
|
|
else if Query is THelpQueryClass then
|
|
Result:=ShowHelpForClass(THelpQueryClass(Query),ErrMsg)
|
|
else
|
|
Result:=shrContextNotFound;
|
|
finally
|
|
if AutoFreeQuery then Query.Free;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabases.ShowHelpForContext(Query: THelpQueryContext;
|
|
var ErrMsg: string): TShowHelpResult;
|
|
var
|
|
Nodes: THelpNodeQueryList;
|
|
HelpDB: THelpDatabase;
|
|
begin
|
|
ErrMsg:='';
|
|
Result:=shrHelpNotFound;
|
|
|
|
// search node
|
|
Nodes:=nil;
|
|
try
|
|
if Query.HelpDatabaseID<>'' then begin
|
|
HelpDB:=nil;
|
|
if not GetDatabase(Query.HelpDatabaseID,HelpDB,Result,ErrMsg) then exit;
|
|
Result:=HelpDB.GetNodesForContext(Query.Context,Nodes,ErrMsg);
|
|
if Result<>shrSuccess then exit;
|
|
end else begin
|
|
Result:=GetNodesForContext(Query.Context,Nodes,ErrMsg);
|
|
if Result<>shrSuccess then exit;
|
|
end;
|
|
|
|
// check if at least one node found
|
|
if (Nodes=nil) or (Nodes.Count=0) then begin
|
|
Result:=shrContextNotFound;
|
|
if Query.HelpDatabaseID<>'' then
|
|
ErrMsg:=Format(rsHelpHelpContextNotFoundInDatabase, [IntToStr(
|
|
Query.Context), '"', Query.HelpDatabaseID, '"'])
|
|
else
|
|
ErrMsg:=Format(rsHelpHelpContextNotFound,
|
|
[IntToStr(Query.Context)]);
|
|
exit;
|
|
end;
|
|
|
|
Result:=ShowHelpForNodes(Query,Nodes,ErrMsg);
|
|
finally
|
|
Nodes.Free;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabases.ShowHelpForKeyword(Query: THelpQueryKeyword;
|
|
var ErrMsg: string): TShowHelpResult;
|
|
var
|
|
Nodes: THelpNodeQueryList;
|
|
HelpDB: THelpDatabase;
|
|
begin
|
|
ErrMsg:='';
|
|
Result:=shrHelpNotFound;
|
|
|
|
// search node
|
|
Nodes:=nil;
|
|
try
|
|
if Query.HelpDatabaseID<>'' then begin
|
|
HelpDB:=nil;
|
|
if not GetDatabase(Query.HelpDatabaseID,HelpDB,Result,ErrMsg) then exit;
|
|
Result:=HelpDB.GetNodesForKeyword(Query.Keyword,Nodes,ErrMsg);
|
|
if Result<>shrSuccess then exit;
|
|
end else begin
|
|
Result:=GetNodesForKeyword(Query.Keyword,Nodes,ErrMsg);
|
|
if Result<>shrSuccess then exit;
|
|
end;
|
|
|
|
// check if at least one node found
|
|
if (Nodes=nil) or (Nodes.Count=0) then begin
|
|
Result:=shrContextNotFound;
|
|
if Query.HelpDatabaseID<>'' then
|
|
ErrMsg:=Format(rsHelpHelpKeywordNotFoundInDatabase, ['"',Query.Keyword,
|
|
'"', '"', Query.HelpDatabaseID, '"'])
|
|
else
|
|
ErrMsg:=Format(rsHelpHelpKeywordNotFound, ['"',Query.Keyword,'"']);
|
|
exit;
|
|
end;
|
|
|
|
Result:=ShowHelpForNodes(Query,Nodes,ErrMsg);
|
|
finally
|
|
Nodes.Free;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabases.ShowHelpForPascalContexts(
|
|
Query: THelpQueryPascalContexts; var ErrMsg: string): TShowHelpResult;
|
|
var
|
|
Nodes: THelpNodeQueryList;
|
|
begin
|
|
ErrMsg:='';
|
|
Result:=shrSuccess;
|
|
|
|
debugln('THelpDatabases.ShowHelpForPascalContexts A Count=',dbgs(Query.ListOfPascalHelpContextList.Count));
|
|
// search node
|
|
Nodes:=nil;
|
|
try
|
|
Result:=GetNodesForPascalContexts(Query.ListOfPascalHelpContextList,Nodes,
|
|
ErrMsg);
|
|
if Result<>shrSuccess then exit;
|
|
|
|
// check if at least one node found
|
|
if (Nodes=nil) or (Nodes.Count=0) then begin
|
|
Result:=shrHelpNotFound;
|
|
ErrMsg:=format(rsHelpNoHelpFoundForSource,
|
|
[Query.SourcePosition.y, Query.SourcePosition.x, Query.Filename]);
|
|
exit;
|
|
end;
|
|
debugln('THelpDatabases.ShowHelpForPascalContexts B Nodes.Count=',dbgs(Nodes.Count));
|
|
|
|
Result:=ShowHelpForNodes(Query,Nodes,ErrMsg);
|
|
finally
|
|
Nodes.Free;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabases.ShowHelpForSourcePosition(
|
|
Query: THelpQuerySourcePosition; var ErrMsg: string): TShowHelpResult;
|
|
begin
|
|
Result:=shrHelpNotFound;
|
|
ErrMsg:='THelpDatabases.ShowHelpForPascalSource not implemented';
|
|
end;
|
|
|
|
function THelpDatabases.ShowHelpForMessageLine(Query: THelpQueryMessage;
|
|
var ErrMsg: string): TShowHelpResult;
|
|
var
|
|
Nodes: THelpNodeQueryList;
|
|
begin
|
|
ErrMsg:='';
|
|
Result:=shrSuccess;
|
|
|
|
debugln('THelpDatabases.ShowHelpForMessageLine A Msg="',Query.WholeMessage,'"');
|
|
// search node
|
|
Nodes:=nil;
|
|
try
|
|
Result:=GetNodesForMessage(Query.WholeMessage,Query.MessageParts,Nodes,
|
|
ErrMsg);
|
|
if Result<>shrSuccess then exit;
|
|
|
|
// check if at least one node found
|
|
if (Nodes=nil) or (Nodes.Count=0) then begin
|
|
Result:=shrHelpNotFound;
|
|
ErrMsg:='No help found for "'+Query.WholeMessage+'"';
|
|
exit;
|
|
end;
|
|
|
|
Result:=ShowHelpForNodes(Query,Nodes,ErrMsg);
|
|
finally
|
|
Nodes.Free;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabases.ShowHelpForClass(Query: THelpQueryClass;
|
|
var ErrMsg: string): TShowHelpResult;
|
|
var
|
|
Nodes: THelpNodeQueryList;
|
|
begin
|
|
ErrMsg:='';
|
|
Result:=shrSuccess;
|
|
|
|
debugln('THelpDatabases.ShowHelpForClass A ',Query.TheClass.ClassName);
|
|
// search node
|
|
Nodes:=nil;
|
|
try
|
|
Result:=GetNodesForClass(Query.TheClass,Nodes,ErrMsg);
|
|
if Result<>shrSuccess then exit;
|
|
|
|
// check if at least one node found
|
|
if (Nodes=nil) or (Nodes.Count=0) then begin
|
|
// no node found for the class is not a bug
|
|
Result:=shrSuccess;
|
|
ErrMsg:='';
|
|
exit;
|
|
end;
|
|
|
|
Result:=ShowHelpForNodes(Query,Nodes,ErrMsg);
|
|
finally
|
|
Nodes.Free;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabases.ShowHelpFile(const Filename, Title, MimeType: string;
|
|
var ErrMsg: string): TShowHelpResult;
|
|
begin
|
|
Result:=ShowHelp(FilenameToURL(Filename),Title,MimeType,ErrMsg);
|
|
end;
|
|
|
|
function THelpDatabases.ShowHelp(const URL, Title, MimeType: string;
|
|
var ErrMsg: string): TShowHelpResult;
|
|
var
|
|
Viewer: THelpViewer;
|
|
Node: THelpNode;
|
|
begin
|
|
ErrMsg:='';
|
|
// get a viewer for this file
|
|
Result:=FindViewer(MimeType,ErrMsg,Viewer);
|
|
if Result<>shrSuccess then exit;
|
|
|
|
// call viewer
|
|
Node:=nil;
|
|
try
|
|
Node:=THelpNode.CreateURL(nil,Title,URL);
|
|
Result:=Viewer.ShowNode(Node,ErrMsg);
|
|
finally
|
|
Node.Free;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabases.GetNodesForKeyword(const HelpKeyword: string;
|
|
var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
|
|
// if ListOfNodes<>nil then new nodes will be appended
|
|
// if ListOfNodes=nil and nodes exists a new list will be created
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result:=shrSuccess;
|
|
ErrMsg:='';
|
|
for i:=Count-1 downto 0 do begin
|
|
Result:=Items[i].GetNodesForKeyword(HelpKeyword,ListOfNodes,ErrMsg);
|
|
if Result<>shrSuccess then exit;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabases.GetNodesForContext(HelpContext: THelpContext;
|
|
var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
|
|
// if ListOfNodes<>nil then new nodes will be appended
|
|
// if ListOfNodes=nil and nodes exists a new list will be created
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result:=shrSuccess;
|
|
ErrMsg:='';
|
|
for i:=Count-1 downto 0 do begin
|
|
Result:=Items[i].GetNodesForContext(HelpContext,ListOfNodes,ErrMsg);
|
|
if Result<>shrSuccess then exit;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabases.GetNodesForPascalContexts(
|
|
ListOfPascalHelpContextList: TList; var ListOfNodes: THelpNodeQueryList;
|
|
var ErrMsg: string): TShowHelpResult;
|
|
// if ListOfNodes<>nil then new nodes will be appended
|
|
// if ListOfNodes=nil and nodes exists a new list will be created
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result:=shrSuccess;
|
|
ErrMsg:='';
|
|
for i:=Count-1 downto 0 do begin
|
|
Result:=Items[i].GetNodesForPascalContexts(ListOfPascalHelpContextList,
|
|
ListOfNodes,ErrMsg);
|
|
if Result<>shrSuccess then exit;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabases.GetNodesForClass(AClass: TClass;
|
|
var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
|
|
// if ListOfNodes<>nil then new nodes will be appended
|
|
// if ListOfNodes=nil and nodes exists a new list will be created
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result:=shrSuccess;
|
|
ErrMsg:='';
|
|
for i:=Count-1 downto 0 do begin
|
|
Result:=Items[i].GetNodesForClass(AClass,ListOfNodes,ErrMsg);
|
|
if Result<>shrSuccess then exit;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabases.GetNodesForMessage(const AMessage: string;
|
|
MessageParts: TStrings; var ListOfNodes: THelpNodeQueryList;
|
|
var ErrMsg: string): TShowHelpResult;
|
|
// if ListOfNodes<>nil then new nodes will be appended
|
|
// if ListOfNodes=nil and nodes exists a new list will be created
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result:=shrSuccess;
|
|
ErrMsg:='';
|
|
for i:=Count-1 downto 0 do begin
|
|
Result:=Items[i].GetNodesForMessage(AMessage,MessageParts,ListOfNodes,
|
|
ErrMsg);
|
|
if Result<>shrSuccess then exit;
|
|
end;
|
|
end;
|
|
|
|
function THelpDatabases.ShowHelpSelector(Query: THelpQuery;
|
|
Nodes: THelpNodeQueryList; var ErrMsg: string;
|
|
var Selection: THelpNodeQuery): TShowHelpResult;
|
|
// to override
|
|
// default is to always take the first node
|
|
begin
|
|
if (Nodes=nil) or (Nodes.Count=0) then begin
|
|
Result:=shrSelectorError;
|
|
Selection:=nil;
|
|
ErrMsg:=rsHelpNoHelpNodesAvailable;
|
|
end else begin
|
|
Selection:=THelpNodeQuery(Nodes[0]);
|
|
Result:=shrSuccess;
|
|
ErrMsg:='';
|
|
end;
|
|
end;
|
|
|
|
procedure THelpDatabases.RegisterHelpDatabaseClass(NewHelpDB: THelpDatabaseClass
|
|
);
|
|
begin
|
|
if FHelpDBClasses=nil then FHelpDBClasses:=TFPList.Create;
|
|
if FHelpDBClasses.IndexOf(NewHelpDB)<0 then
|
|
FHelpDBClasses.Add(NewHelpDB);
|
|
end;
|
|
|
|
procedure THelpDatabases.UnregisterHelpDatabaseClass(
|
|
AHelpDB: THelpDatabaseClass);
|
|
begin
|
|
if FHelpDBClasses=nil then exit;
|
|
FHelpDBClasses.Remove(AHelpDB);
|
|
end;
|
|
|
|
function THelpDatabases.HelpDatabaseClassCount: integer;
|
|
begin
|
|
if FHelpDBClasses=nil then
|
|
Result:=0
|
|
else
|
|
Result:=FHelpDBClasses.Count;
|
|
end;
|
|
|
|
function THelpDatabases.GetHelpDatabaseClass(Index: integer
|
|
): THelpDatabaseClass;
|
|
begin
|
|
Result:=THelpDatabaseClass(FHelpDBClasses[Index]);
|
|
end;
|
|
|
|
procedure THelpDatabases.Load(Storage: TConfigStorage);
|
|
var
|
|
i: Integer;
|
|
HelpDB: THelpDatabase;
|
|
Path: String;
|
|
begin
|
|
for i:=0 to Count-1 do begin
|
|
HelpDB:=Items[i];
|
|
Path:=HelpDB.ID;
|
|
if (Path='') or (not IsValidIdent(Path)) then continue;
|
|
Storage.AppendBasePath(Path);
|
|
try
|
|
HelpDB.Load(Storage);
|
|
finally
|
|
Storage.UndoAppendBasePath;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure THelpDatabases.Save(Storage: TConfigStorage);
|
|
var
|
|
i: Integer;
|
|
HelpDB: THelpDatabase;
|
|
Path: String;
|
|
begin
|
|
for i:=0 to Count-1 do begin
|
|
HelpDB:=Items[i];
|
|
Path:=HelpDB.ID;
|
|
if (Path='') or (not IsValidIdent(Path)) then continue;
|
|
Storage.AppendBasePath(Path);
|
|
try
|
|
HelpDB.Save(Storage);
|
|
finally
|
|
Storage.UndoAppendBasePath;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ THelpViewers }
|
|
|
|
function THelpViewers.GetItems(Index: integer): THelpViewer;
|
|
begin
|
|
Result:=THelpViewer(FItems[Index]);
|
|
end;
|
|
|
|
constructor THelpViewers.Create;
|
|
begin
|
|
FItems:=TFPList.Create;
|
|
end;
|
|
|
|
destructor THelpViewers.Destroy;
|
|
begin
|
|
FDestroying:=true;
|
|
Clear;
|
|
FreeAndNil(fItems);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure THelpViewers.Clear;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i:=Count-1;
|
|
while (i>=0) do begin
|
|
if i<Count then begin
|
|
if Items[i].Owner=nil then begin
|
|
Items[i].Free;
|
|
if fItems=nil then exit;
|
|
end;
|
|
if i<Count then
|
|
FItems[i]:=nil;
|
|
end;
|
|
dec(i);
|
|
end;
|
|
FItems.Clear;
|
|
end;
|
|
|
|
function THelpViewers.Count: integer;
|
|
begin
|
|
if fItems<>nil then
|
|
Result:=FItems.Count
|
|
else
|
|
Result:=0;
|
|
end;
|
|
|
|
function THelpViewers.GetViewersSupportingMimeType(
|
|
const MimeType: string): TList;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result:=nil;
|
|
// LIFO: last registered, first shown
|
|
for i:=Count-1 downto 0 do
|
|
if Items[i].SupportsMimeType(MimeType) then begin
|
|
if Result=nil then Result:=TList.Create;
|
|
Result.Add(Items[i]);
|
|
end;
|
|
end;
|
|
|
|
procedure THelpViewers.RegisterViewer(AHelpViewer: THelpViewer);
|
|
begin
|
|
FItems.Add(AHelpViewer);
|
|
end;
|
|
|
|
procedure THelpViewers.UnregisterViewer(AHelpViewer: THelpViewer);
|
|
begin
|
|
if FDestroying then exit;
|
|
FItems.Remove(AHelpViewer);
|
|
end;
|
|
|
|
procedure THelpViewers.Load(Storage: TConfigStorage);
|
|
var
|
|
i: Integer;
|
|
Viewer: THelpViewer;
|
|
Path: String;
|
|
begin
|
|
for i:=0 to Count-1 do begin
|
|
Viewer:=Items[i];
|
|
Path:=Viewer.StorageName;
|
|
if (Path='') or (not IsValidIdent(Path)) then continue;
|
|
Storage.AppendBasePath(Path);
|
|
try
|
|
Viewer.Load(Storage);
|
|
finally
|
|
Storage.UndoAppendBasePath;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure THelpViewers.Save(Storage: TConfigStorage);
|
|
var
|
|
i: Integer;
|
|
Viewer: THelpViewer;
|
|
Path: String;
|
|
begin
|
|
for i:=0 to Count-1 do begin
|
|
Viewer:=Items[i];
|
|
Path:=Viewer.StorageName;
|
|
if (Path='') or (not IsValidIdent(Path)) then continue;
|
|
Storage.AppendBasePath(Path);
|
|
try
|
|
Viewer.Save(Storage);
|
|
finally
|
|
Storage.UndoAppendBasePath;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function THelpViewers.IndexOf(AHelpViewer: THelpViewer): integer;
|
|
begin
|
|
Result:=FItems.IndexOf(AHelpViewer);
|
|
end;
|
|
|
|
{ THelpViewer }
|
|
|
|
procedure THelpViewer.SetAutoRegister(const AValue: boolean);
|
|
begin
|
|
if FAutoRegister=AValue then exit;
|
|
FAutoRegister:=AValue;
|
|
if not (csDesigning in ComponentState) then begin
|
|
if FAutoRegister then begin
|
|
RegisterSelf;
|
|
end else begin
|
|
UnregisterSelf;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure THelpViewer.SetSupportedMimeTypes(List: TStrings);
|
|
begin
|
|
if FSupportedMimeTypes<>nil then FSupportedMimeTypes.Free;
|
|
FSupportedMimeTypes:=nil;
|
|
end;
|
|
|
|
procedure THelpViewer.AddSupportedMimeType(const AMimeType: string);
|
|
begin
|
|
if FSupportedMimeTypes=nil then FSupportedMimeTypes:=TStringList.Create;
|
|
FSupportedMimeTypes.Add(AMimeType);
|
|
end;
|
|
|
|
constructor THelpViewer.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
FStorageName:=ClassName;
|
|
end;
|
|
|
|
destructor THelpViewer.Destroy;
|
|
begin
|
|
UnregisterSelf;
|
|
FreeAndNil(FSupportedMimeTypes);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function THelpViewer.SupportsTableOfContents: boolean;
|
|
begin
|
|
Result:=false;
|
|
end;
|
|
|
|
procedure THelpViewer.ShowTableOfContents(Node: THelpNode);
|
|
begin
|
|
raise EHelpSystemException.Create('THelpViewer.ShowTableOfContents not implemented');
|
|
end;
|
|
|
|
function THelpViewer.SupportsMimeType(const AMimeType: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
if FSupportedMimeTypes<>nil then
|
|
Result:=(FSupportedMimeTypes.IndexOf(AMimeType)>=0);
|
|
end;
|
|
|
|
function THelpViewer.ShowNode(Node: THelpNode; var ErrMsg: string
|
|
): TShowHelpResult;
|
|
begin
|
|
// for descendents to override
|
|
Result:=shrViewerError;
|
|
ErrMsg:='THelpViewer.ShowNode not implemented for this help type';
|
|
end;
|
|
|
|
procedure THelpViewer.Hide;
|
|
begin
|
|
// override this
|
|
end;
|
|
|
|
procedure THelpViewer.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is THelpViewer then begin
|
|
|
|
end;
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure THelpViewer.Load(Storage: TConfigStorage);
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure THelpViewer.Save(Storage: TConfigStorage);
|
|
begin
|
|
|
|
end;
|
|
|
|
function THelpViewer.GetLocalizedName: string;
|
|
begin
|
|
Result:=StorageName;
|
|
end;
|
|
|
|
procedure THelpViewer.RegisterSelf;
|
|
begin
|
|
if (HelpViewers<>nil) and (HelpViewers.IndexOf(Self)>=0) then
|
|
raise EHelpSystemException.Create('help viewer is already registered');
|
|
CreateLCLHelpSystem;
|
|
HelpViewers.RegisterViewer(Self);
|
|
end;
|
|
|
|
procedure THelpViewer.UnregisterSelf;
|
|
begin
|
|
if (HelpViewers=nil) or (HelpViewers.IndexOf(Self)<0) then exit;
|
|
HelpViewers.UnregisterViewer(Self);
|
|
FreeUnusedLCLHelpSystem;
|
|
end;
|
|
|
|
{ THelpNode }
|
|
|
|
constructor THelpNode.Create(TheOwner: THelpDatabase; Node: THelpNode);
|
|
begin
|
|
FOwner:=TheOwner;
|
|
Assign(Node);
|
|
end;
|
|
|
|
constructor THelpNode.Create(TheOwner: THelpDatabase; const TheTitle,
|
|
TheURL, TheID: string; TheContext: THelpContext);
|
|
begin
|
|
FOwner:=TheOwner;
|
|
FHelpType:=hntURLIDContext;
|
|
FTitle:=TheTitle;
|
|
FURL:=TheURL;
|
|
FID:=TheID;
|
|
FContext:=TheContext;
|
|
end;
|
|
|
|
constructor THelpNode.CreateURL(TheOwner: THelpDatabase; const TheTitle,
|
|
TheURL: string);
|
|
begin
|
|
FOwner:=TheOwner;
|
|
FHelpType:=hntURL;
|
|
FTitle:=TheTitle;
|
|
FURL:=TheURL;
|
|
end;
|
|
|
|
constructor THelpNode.CreateID(TheOwner: THelpDatabase;
|
|
const TheTitle, TheID: string);
|
|
begin
|
|
FOwner:=TheOwner;
|
|
FHelpType:=hntID;
|
|
FTitle:=TheTitle;
|
|
FID:=TheID;
|
|
end;
|
|
|
|
constructor THelpNode.CreateURLID(TheOwner: THelpDatabase;
|
|
const TheTitle, TheURL, TheID: string);
|
|
begin
|
|
FOwner:=TheOwner;
|
|
FHelpType:=hntURLID;
|
|
FTitle:=TheTitle;
|
|
FURL:=TheURL;
|
|
FID:=TheID;
|
|
end;
|
|
|
|
constructor THelpNode.CreateContext(TheOwner: THelpDatabase;
|
|
const TheTitle: string; TheContext: THelpContext);
|
|
begin
|
|
FOwner:=TheOwner;
|
|
FHelpType:=hntContext;
|
|
FTitle:=TheTitle;
|
|
FContext:=TheContext;
|
|
end;
|
|
|
|
constructor THelpNode.CreateURLContext(TheOwner: THelpDatabase; const TheTitle,
|
|
TheURL: string; TheContext: THelpContext);
|
|
begin
|
|
FOwner:=TheOwner;
|
|
FHelpType:=hntURLContext;
|
|
FTitle:=TheTitle;
|
|
FURL:=TheURL;
|
|
FContext:=TheContext;
|
|
end;
|
|
|
|
function THelpNode.URLValid: boolean;
|
|
begin
|
|
Result:=FHelpType in [hntURL,hntURLIDContext,hntURLID,hntURLContext];
|
|
end;
|
|
|
|
function THelpNode.IDValid: boolean;
|
|
begin
|
|
Result:=FHelpType in [hntURLIDContext,hntURLID,hntID];
|
|
end;
|
|
|
|
function THelpNode.ContextValid: boolean;
|
|
begin
|
|
Result:=FHelpType in [hntURLIDContext,hntURLContext,hntContext];
|
|
end;
|
|
|
|
function THelpNode.AsString: string;
|
|
begin
|
|
Result:=Title;
|
|
end;
|
|
|
|
procedure THelpNode.Assign(Source: TPersistent);
|
|
var
|
|
Node: THelpNode;
|
|
begin
|
|
if Source is THelpNode then begin
|
|
Node:=THelpNode(Source);
|
|
FHelpType:=Node.HelpType;
|
|
FTitle:=Node.Title;
|
|
FURL:=Node.URL;
|
|
FID:=Node.ID;
|
|
FContext:=Node.Context;
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
{ THelpDBItem }
|
|
|
|
constructor THelpDBItem.Create(TheNode: THelpNode);
|
|
begin
|
|
Node:=TheNode
|
|
end;
|
|
|
|
destructor THelpDBItem.Destroy;
|
|
begin
|
|
Node.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TPascalHelpContextList }
|
|
|
|
function TPascalHelpContextList.GetItems(Index: integer): TPascalHelpContext;
|
|
begin
|
|
Result:=fItems[Index];
|
|
end;
|
|
|
|
procedure TPascalHelpContextList.Add(const Context: TPascalHelpContext);
|
|
begin
|
|
inc(FCount);
|
|
ReAllocMem(fItems,SizeOf(TPascalHelpContext)*FCount);
|
|
// to prevent freeing uninitialized strings, initialize the new strings to nil
|
|
FillChar(fItems[FCount-1], SizeOf(TPascalHelpContext), 0);
|
|
fItems[FCount-1]:=Context;
|
|
end;
|
|
|
|
procedure TPascalHelpContextList.Insert(Index: integer;
|
|
const Context: TPascalHelpContext);
|
|
begin
|
|
inc(FCount);
|
|
ReAllocMem(fItems,SizeOf(TPascalHelpContext)*FCount);
|
|
if Index<FCount-1 then
|
|
System.Move(fItems[Index],fItems[Index+1],
|
|
SizeOf(TPascalHelpContext)*(FCount-Index-1));
|
|
// to prevent freeing uninitialized strings, initialize the new strings to nil
|
|
FillChar(fItems[Index], SizeOf(TPascalHelpContext), 0);
|
|
fItems[Index]:=Context;
|
|
end;
|
|
|
|
procedure TPascalHelpContextList.Clear;
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
// Set all item strings to '', so fpc will finalize them.
|
|
for Index := 0 to FCount-1 do
|
|
fItems[Index].Context := '';
|
|
ReAllocMem(fItems,0);
|
|
end;
|
|
|
|
destructor TPascalHelpContextList.Destroy;
|
|
begin
|
|
Clear;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TPascalHelpContextList.IsEqual(QueryItem: THelpQueryItem): boolean;
|
|
begin
|
|
Result:=(QueryItem is TPascalHelpContextList)
|
|
and (CompareList(TPascalHelpContextList(QueryItem))=0);
|
|
end;
|
|
|
|
function TPascalHelpContextList.CompareList(AList: TPascalHelpContextList
|
|
): integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i:=0;
|
|
while (i<Count) and (i<AList.Count) do begin
|
|
if fItems[i].Descriptor<AList.fItems[i].Descriptor then begin
|
|
Result:=1;
|
|
exit;
|
|
end else if fItems[i].Descriptor>AList.fItems[i].Descriptor then begin
|
|
Result:=-1;
|
|
exit;
|
|
end else begin
|
|
Result:=CompareText(fItems[i].Context,AList.fItems[i].Context);
|
|
if Result<>0 then exit;
|
|
end;
|
|
inc(i);
|
|
end;
|
|
if Count>i then
|
|
Result:=-1
|
|
else
|
|
Result:=1;
|
|
end;
|
|
|
|
function TPascalHelpContextList.AsString: string;
|
|
var
|
|
i: Integer;
|
|
Item: TPascalHelpContext;
|
|
Filename: String;
|
|
begin
|
|
Result:='';
|
|
i:=0;
|
|
while (i<Count) and (Items[i].Descriptor=pihcFilename) do begin
|
|
Filename:=Items[i].Context;
|
|
inc(i);
|
|
end;
|
|
while i<Count do begin
|
|
Item:=Items[i];
|
|
case Item.Descriptor of
|
|
pihcFilename: Result:=Result+Item.Context;
|
|
pihcSourceName: ;
|
|
pihcProperty: Result:=Result+' property '+Item.Context;
|
|
pihcProcedure: Result:=Result+' procedure/function '+Item.Context;
|
|
pihcParameterList: Result:=Result+Item.Context;
|
|
pihcVariable: Result:=Result+' var '+Item.Context;
|
|
pihcType: Result:=Result+' type '+Item.Context;
|
|
pihcConst: Result:=Result+' const '+Item.Context;
|
|
end;
|
|
//DebugLn(['TPascalHelpContextList.AsString ',i,' ',Item.Descriptor,' ',Result]);
|
|
inc(i);
|
|
end;
|
|
if Filename<>'' then
|
|
Result:=Result+' in '+Filename;
|
|
end;
|
|
|
|
{ THelpDBISourceFile }
|
|
|
|
procedure THelpDBISourceFile.SetFilename(const AValue: string);
|
|
begin
|
|
FFilename:=AValue;
|
|
end;
|
|
|
|
constructor THelpDBISourceFile.Create(TheNode: THelpNode;
|
|
const TheFilename: string);
|
|
begin
|
|
inherited Create(TheNode);
|
|
FFilename:=TrimFilename(SetDirSeparators(TheFilename));
|
|
end;
|
|
|
|
function THelpDBISourceFile.FileMatches(const AFilename: string): boolean;
|
|
begin
|
|
if (FFilename<>'') and (AFilename<>'') then
|
|
Result:=CompareFilenames(GetFullFilename,AFilename)=0
|
|
else
|
|
Result:=false;
|
|
end;
|
|
|
|
function THelpDBISourceFile.GetFullFilename: string;
|
|
var
|
|
BaseDir: String;
|
|
ExpFilename: String;
|
|
begin
|
|
ExpFilename:=FFilename;
|
|
//DebugLn(['THelpDBISourceFile.GetFullFilename ExpFilename="',ExpFilename,'"']);
|
|
if (HelpDatabases<>nil) then
|
|
HelpDatabases.SubstituteMacros(ExpFilename);
|
|
ExpFilename:=TrimFilename(ExpFilename);
|
|
if FilenameIsAbsolute(ExpFilename) then
|
|
Result:=ExpFilename
|
|
else begin
|
|
BaseDir:=GetBasePath;
|
|
Result:=BaseDir+ExpFilename;
|
|
end;
|
|
end;
|
|
|
|
function THelpDBISourceFile.GetBasePath: string;
|
|
begin
|
|
if BasePathObject=nil then
|
|
Result:=''
|
|
else
|
|
Result:=AppendPathDelim(
|
|
HelpDatabases.GetBaseDirectoryForBasePathObject(BasePathObject));
|
|
end;
|
|
|
|
{ THelpDBISourceDirectory }
|
|
|
|
constructor THelpDBISourceDirectory.Create(TheNode: THelpNode;
|
|
const TheFilename, TheFileMask: string; Recursive: boolean);
|
|
begin
|
|
inherited Create(TheNode,TheFilename);
|
|
FFileMask:=SetDirSeparators(TheFileMask);
|
|
WithSubDirectories:=Recursive;
|
|
end;
|
|
|
|
function THelpDBISourceDirectory.FileMatches(const AFilename: string
|
|
): boolean;
|
|
var
|
|
TheDirectory: String;
|
|
begin
|
|
Result:=false;
|
|
//debugln('THelpDBISourceDirectory.FileMatches AFilename="',AFilename,'" FFilename="',FFilename,'"');
|
|
if (FFilename='') or (AFilename='') then exit;
|
|
TheDirectory:=GetFullFilename;
|
|
if TheDirectory='' then begin
|
|
DebugLn(['WARNING: THelpDBISourceDirectory.FileMatches ',DbgSName(Self),' Filename="',Filename,'" -> ""']);
|
|
exit;
|
|
end;
|
|
//debugln('THelpDBISourceDirectory.FileMatches TheDirectory="',TheDirectory,'" WithSubDirectories=',dbgs(WithSubDirectories));
|
|
if WithSubDirectories then begin
|
|
if not FileIsInPath(AFilename,TheDirectory) then exit;
|
|
end else begin
|
|
if not FileIsInDirectory(AFilename,TheDirectory) then exit;
|
|
end;
|
|
//debugln('THelpDBISourceDirectory.FileMatches FileMask="',FileMask,'"');
|
|
if (FileMask<>'')
|
|
and (not MatchesMaskList(ExtractFilename(AFilename),FileMask)) then exit;
|
|
//debugln('THelpDBISourceDirectory.FileMatches Success');
|
|
Result:=true;
|
|
end;
|
|
|
|
{ THelpQueryNode }
|
|
|
|
constructor THelpQueryNode.Create(const TheHelpDatabaseID: THelpDatabaseID;
|
|
const TheNode: THelpNode);
|
|
begin
|
|
inherited Create(TheHelpDatabaseID);
|
|
FNode:=TheNode;
|
|
end;
|
|
|
|
{ THelpBasePathObject }
|
|
|
|
procedure THelpBasePathObject.SetBasePath(const AValue: string);
|
|
begin
|
|
if FBasePath=AValue then exit;
|
|
FBasePath:=AValue;
|
|
end;
|
|
|
|
constructor THelpBasePathObject.Create;
|
|
begin
|
|
|
|
end;
|
|
|
|
constructor THelpBasePathObject.Create(const TheBasePath: string);
|
|
begin
|
|
BasePath:=TheBasePath;
|
|
end;
|
|
|
|
{ THelpNodeQuery }
|
|
|
|
constructor THelpNodeQuery.Create;
|
|
begin
|
|
|
|
end;
|
|
|
|
constructor THelpNodeQuery.Create(TheNode: THelpNode;
|
|
TheQueryItem: THelpQueryItem);
|
|
begin
|
|
Create;
|
|
FNode:=TheNode;
|
|
FQueryItem:=TheQueryItem;
|
|
end;
|
|
|
|
function THelpNodeQuery.IsEqual(TheNode: THelpNode; TheQueryItem: THelpQueryItem
|
|
): boolean;
|
|
begin
|
|
Result:=(Node=TheNode) and (QueryItem.IsEqual(TheQueryItem))
|
|
end;
|
|
|
|
function THelpNodeQuery.IsEqual(NodeQuery: THelpNodeQuery): boolean;
|
|
begin
|
|
Result:=IsEqual(NodeQuery.Node,NodeQuery.QueryItem)
|
|
end;
|
|
|
|
function THelpNodeQuery.AsString: string;
|
|
begin
|
|
Result:=Node.AsString;
|
|
if QueryItem<>nil then
|
|
Result:=Result+' ('+QueryItem.AsString+')';
|
|
end;
|
|
|
|
{ THelpNodeQueryList }
|
|
|
|
function THelpNodeQueryList.GetItems(Index: integer): THelpNodeQuery;
|
|
begin
|
|
Result:=THelpNodeQuery(fItems[Index]);
|
|
end;
|
|
|
|
procedure THelpNodeQueryList.SetItems(Index: integer;
|
|
const AValue: THelpNodeQuery);
|
|
begin
|
|
fItems[Index]:=AValue;
|
|
end;
|
|
|
|
constructor THelpNodeQueryList.Create;
|
|
begin
|
|
fItems:=TFPList.Create;
|
|
end;
|
|
|
|
destructor THelpNodeQueryList.Destroy;
|
|
begin
|
|
Clear;
|
|
fItems.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function THelpNodeQueryList.Count: integer;
|
|
begin
|
|
Result:=fItems.Count;
|
|
end;
|
|
|
|
function THelpNodeQueryList.Add(NodeQuery: THelpNodeQuery): integer;
|
|
begin
|
|
Result:=fItems.Add(NodeQuery);
|
|
end;
|
|
|
|
function THelpNodeQueryList.Add(Node: THelpNode; QueryItem: THelpQueryItem
|
|
): integer;
|
|
begin
|
|
Result:=Add(THelpNodeQuery.Create(Node,QueryItem));
|
|
end;
|
|
|
|
procedure THelpNodeQueryList.Delete(Index: integer);
|
|
begin
|
|
TObject(fItems[Index]).Free;
|
|
fItems.Delete(Index);
|
|
end;
|
|
|
|
function THelpNodeQueryList.IndexOf(NodeQuery: THelpNodeQuery): integer;
|
|
begin
|
|
Result:=Count;
|
|
while (Result>=0) and (not Items[Result].IsEqual(NodeQuery)) do
|
|
dec(Result);
|
|
end;
|
|
|
|
function THelpNodeQueryList.IndexOf(Node: THelpNode; QueryItem: THelpQueryItem
|
|
): integer;
|
|
begin
|
|
Result:=Count-1;
|
|
while (Result>=0) and (not Items[Result].IsEqual(Node,QueryItem)) do
|
|
dec(Result);
|
|
end;
|
|
|
|
procedure THelpNodeQueryList.Clear;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i:=0 to Count-1 do TObject(fItems[i]).Free;
|
|
fItems.Clear;
|
|
end;
|
|
|
|
{ THelpQueryItem }
|
|
|
|
function THelpQueryItem.IsEqual(QueryItem: THelpQueryItem): boolean;
|
|
begin
|
|
Result:=AsString=QueryItem.AsString;
|
|
end;
|
|
|
|
{ THelpBaseURLObject }
|
|
|
|
procedure THelpBaseURLObject.SetBaseURL(const AValue: string);
|
|
begin
|
|
if FBaseURL=AValue then exit;
|
|
FBaseURL:=AValue;
|
|
end;
|
|
|
|
constructor THelpBaseURLObject.Create;
|
|
begin
|
|
|
|
end;
|
|
|
|
constructor THelpBaseURLObject.Create(const TheBaseURL: string);
|
|
begin
|
|
BaseURL:=TheBaseURL;
|
|
end;
|
|
|
|
end.
|
|
|