mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 06:59:33 +01:00
325 lines
9.5 KiB
ObjectPascal
325 lines
9.5 KiB
ObjectPascal
{
|
|
This file is part of the Free Pascal Integrated Development Environment
|
|
Copyright (c) 2008 by Marco van de Voort
|
|
|
|
Wrapper for CHM reading to avoid having to import Delphi units into whtmlhlp,
|
|
which can cause all kinds of namespace conflicts.
|
|
|
|
See the file COPYING.FPC, 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.
|
|
|
|
**********************************************************************}
|
|
unit wchmhwrap;
|
|
|
|
interface
|
|
{$Mode Delphi}
|
|
|
|
Uses wutils,whelp,whtml,SysUtils,ChmReader,ChmSiteMap,Classes;
|
|
|
|
Type
|
|
// TopicLinks: PTopicLinkCollection;IndexEntries : PUnsortedIndexEntryCollection;
|
|
|
|
TChmWrapper = Class
|
|
private
|
|
ffs : Classes.TFileStream;
|
|
fchmr : TChmReader;
|
|
findex : TChmSiteMap;
|
|
ftopic : TChmSiteMap;
|
|
floaded : boolean;
|
|
fileid : integer;
|
|
fshortname : string;
|
|
flongname : string;
|
|
fTopicLinks : PTopicLinkCollection;
|
|
public
|
|
constructor Create(name:String;aid:integer;TopicLinks:PTopicLinkCollection);
|
|
function LoadIndex(id:integer;TopicLinks: PTopicLinkCollection;IndexEntries : PUnsortedIndexEntryCollection;helpfacility:PHelpFacility):boolean;
|
|
function GetTopic(name:string):PMemoryTextFile;
|
|
destructor Destroy;override;
|
|
end;
|
|
|
|
function combinepaths(relpath,basepath:String):String;
|
|
function CHMResolve( href: ansistring; var AFileId,ALinkId : longint):boolean;
|
|
|
|
function stringreplace(const s:ansistring;const oldstr:ansistring; const newstr:ansistring):ansistring;
|
|
implementation
|
|
|
|
var CHMIndex : TStringList; // list to register open CHMs.
|
|
|
|
|
|
function combinepaths(relpath,basepath:String):String;
|
|
|
|
begin
|
|
{$ifdef combinedebug}
|
|
debugmessageS({$i %file%},'combine in "'+relpath+'" and "'+basepath+'"',{$i %line%},'1',0,0);
|
|
{$endif}
|
|
|
|
if relpath='' then exit;
|
|
if relpath[length(relpath)]<>'/' Then
|
|
basepath:=extractfiledir(basepath);
|
|
while (length(relpath)>0) and (copy(relpath,1,3)='../') do
|
|
begin
|
|
basepath:=extractfiledir(basepath);
|
|
delete(relpath,1,3);
|
|
end;
|
|
|
|
{$ifdef combinedebug}
|
|
debugmessageS({$i %file%},'combine out "'+relpath+'" and "'+basepath+'"',{$i %line%},'1',0,0);
|
|
{$endif}
|
|
if (length(basepath)>0) and (length(relpath)>0) then
|
|
begin
|
|
if (relpath[1]<>'/') and (basepath[length(basepath)]<>'/') then
|
|
basepath:=basepath+'/';
|
|
{$ifdef combinedebug}
|
|
debugmessageS({$i %file%},'combine out2 "'+relpath+'" and "'+basepath+'"',{$i %line%},'1',0,0);
|
|
{$endif}
|
|
end;
|
|
|
|
result:=basepath+relpath;
|
|
end;
|
|
|
|
Constructor TChmWrapper.Create(name:string;aid:integer;TopicLinks:PTopicLinkCollection);
|
|
|
|
begin
|
|
ffs:=Classes.TFileStream.create(name,fmOpenRead or fmsharedenynone);
|
|
fchmr:=TChmReader.Create(ffs,True); // owns ffs
|
|
findex:=nil;
|
|
FTopicLinks:=TopicLinks;
|
|
if not fchmr.isvalidfile then
|
|
begin
|
|
freeandnil(fchmr);
|
|
freeandnil(ffs);
|
|
exit;
|
|
end;
|
|
fileid:=aid;
|
|
flongname:=name;
|
|
fshortname:=lowercase(extractfilename(name)); // We assume ms-its: urls are case insensitive wrt filename.
|
|
chmindex.addobject(fshortname,self);
|
|
{$ifdef wdebug}
|
|
debugmessageS({$i %file%},'TCHMWrapper.Create: before sitemap creation '+fshortname+' id='+inttostr(aid),{$i %line%},'1',0,0);
|
|
{$endif}
|
|
findex:=TChmSiteMap.create(stindex);
|
|
ftopic:=TChmSiteMap.create(sttoc);
|
|
floaded:=false;
|
|
end;
|
|
|
|
function TChmWrapper.LoadIndex(id:integer;TopicLinks: PTopicLinkCollection;IndexEntries : PUnsortedIndexEntryCollection;helpfacility:PHelpFacility):boolean;
|
|
function FormatAlias(Alias: string): string;
|
|
begin
|
|
if Assigned(HelpFacility) then
|
|
if length(Alias)>HelpFacility^.IndexTabSize-4 then
|
|
Alias:=Trim(copy(Alias,1,HelpFacility^.IndexTabSize-4-2))+'..';
|
|
// if (length(alias)>0) and (alias[1]<>'/') then Alias:='/'+alias;
|
|
FormatAlias:=Alias;
|
|
end;
|
|
|
|
var
|
|
m : Classes.TMemoryStream;
|
|
i,j : integer;
|
|
item : TChmSiteMapItem;
|
|
tli: integer;
|
|
s : String;
|
|
begin
|
|
result:=false;
|
|
if floaded then exit;
|
|
if not assigned (fchmr) then exit;
|
|
{$ifdef wdebug}
|
|
debugmessageS({$i %file%},'TCHMWrapper: indexfilename:'+fchmr.indexfile,{$i %line%},'1',0,0);
|
|
{$endif}
|
|
|
|
|
|
findex:=fchmr.GetIndexSitemap(false);
|
|
(* m:=fchmr.getobject(fchmr.indexfile);
|
|
try
|
|
if assigned(m) then
|
|
begin
|
|
{$ifdef wdebug}
|
|
debugmessageS({$i %file%},'TCHMWrapper: stream size loaded :'+inttostr(m.size),{$i %line%},'1',0,0);
|
|
{$endif}
|
|
findex.loadfromStream(m);
|
|
end;
|
|
finally
|
|
freeandnil(m);
|
|
end;
|
|
*)
|
|
{$ifdef wdebug}
|
|
debugmessageS({$i %file%},'TCHMWrapper: loadindex after final ',{$i %line%},'1',0,0);
|
|
{$endif}
|
|
|
|
tli:=TopicLinks^.AddItem(fchmr.defaultpage);
|
|
TLI:=EncodeHTMLCtx(ID,TLI+1);
|
|
IndexEntries^.Insert(NewIndexEntry( FormatAlias('Table of contents'),ID,TLI));
|
|
if findex= Nil Then
|
|
begin
|
|
floaded:=true;
|
|
exit(true);
|
|
end;
|
|
if assigned(findex.items) and (findex.items.count>0) Then
|
|
for i:=0 to findex.items.count-1 do
|
|
begin
|
|
item:=findex.items.item[i];
|
|
s:=formatalias(item.text);
|
|
if s<>'' then
|
|
begin
|
|
if (length(item.local)>0) and (item.local[1]<>'/') then
|
|
tli:=TopicLinks^.AddItem('/'+item.local)
|
|
else
|
|
tli:=TopicLinks^.AddItem(item.local);
|
|
TLI:=EncodeHTMLCtx(ID,TLI+1);
|
|
IndexEntries^.Insert(NewIndexEntry( FormatAlias(item.text),ID,TLI));
|
|
end;
|
|
end;
|
|
{$ifdef wdebug}
|
|
debugmessageS({$i %file%},'TCHMWrapper: endloadindex ',{$i %line%},'1',0,0);
|
|
{$endif}
|
|
floaded:=true;
|
|
result:=true;
|
|
end;
|
|
|
|
procedure splitline(idestream:PMemoryTextFile;s:ansistring);
|
|
|
|
function scanvalue:integer; // searches for a possible breaking point left of char 255.
|
|
var n,i : integer;
|
|
lastpoint:integer;
|
|
inquote : boolean;
|
|
begin
|
|
lastpoint:=-1;
|
|
n:=length(s);
|
|
if n>250 then n:=250;
|
|
i:=1; inquote:=false;
|
|
while (i<=n) do
|
|
begin
|
|
while (s[i]<>' ') and (s[i]<>'"') and (i<=n) do inc(i);
|
|
if (s[i]=' ') and not inquote then lastpoint:=i;
|
|
if (s[i]='"') then inquote:=not inquote;
|
|
inc(i);
|
|
end;
|
|
scanvalue:=lastpoint;
|
|
end;
|
|
|
|
var position : longint;
|
|
|
|
begin
|
|
position:=0;
|
|
while (length(s)>250) and (position<>-1) do
|
|
begin
|
|
position:=scanvalue;
|
|
if position<>-1 then
|
|
begin
|
|
idestream.addline(copy(s,1,position-1));
|
|
delete(s,1,position);
|
|
end;
|
|
end;
|
|
if length(s)<>0 then
|
|
idestream.addline(s);
|
|
end;
|
|
|
|
function TChmWrapper.GetTopic(name:string):PMemoryTextFile;
|
|
|
|
var
|
|
m : Classes.TMemorystream;
|
|
linedata:Classes.TStringList;
|
|
i : integer;
|
|
begin
|
|
result:=nil;
|
|
if not assigned(fchmr) or (name='') then exit;
|
|
|
|
If (name[1]<>'/') and (copy(name,1,7)<>'ms-its:') Then
|
|
name:='/'+name;
|
|
linedata:=Classes.TStringList.create;
|
|
try
|
|
{$ifdef wdebug}
|
|
debugmessageS({$i %file%},'TCHMWrapper: Getting file '+name,{$i %line%},'1',0,0);
|
|
{$endif}
|
|
// if uppercase(name)='TABLE OF CONTENTS' Then
|
|
// m:=fchmr.getobject(fchmr.tocfile)
|
|
// else
|
|
m:=fchmr.getobject(name);
|
|
|
|
if not assigned(m) then exit;
|
|
linedata.loadfromstream(m);
|
|
result:=new(PMemoryTextFile,Init);
|
|
for i:=0 to linedata.count-1 do
|
|
begin
|
|
if length(linedata[i])>250 Then
|
|
splitline(result,linedata[i])
|
|
else
|
|
result.addline(linedata[i]);
|
|
end;
|
|
finally
|
|
m.free;
|
|
linedata.free;
|
|
end;
|
|
end;
|
|
|
|
destructor TChmWrapper.Destroy;
|
|
|
|
var i : integer;
|
|
begin
|
|
i:=chmindex.indexof(fshortname);
|
|
if i<>-1 then
|
|
begin
|
|
chmindex.delete(i);
|
|
{$ifdef wdebug}
|
|
debugmessageS({$i %file%},'TCHMWrapper: deregistering '+fshortname,{$i %line%},'1',0,0);
|
|
{$endif}
|
|
end;
|
|
freeandnil(ftopic);
|
|
freeandnil(findex);
|
|
freeandnil(fchmr);
|
|
{$ifdef wdebug}
|
|
debugmessageS({$i %file%},'TCHMWrapper: destroying ',{$i %line%},'1',0,0);
|
|
{$endif}
|
|
|
|
end;
|
|
|
|
function CHMResolve( href: ansistring; var AFileId,ALinkId : longint):boolean;
|
|
|
|
var filename, restlink : ansistring;
|
|
I :integer;
|
|
chmw: TCHMWrapper;
|
|
begin
|
|
result:=false;
|
|
if copy(href,1,7)='ms-its:' then
|
|
begin
|
|
{$ifdef wdebug}
|
|
debugmessageS({$i %file%},'TCHMWrapper: resolving '+href,{$i %line%},'1',0,0);
|
|
{$endif}
|
|
|
|
delete(href,1,7);
|
|
i:=pos('::',href);
|
|
if i<>0 then
|
|
begin
|
|
filename:=lowercase(copy(href,1,i-1));
|
|
restlink:=lowercase(copy(href,i+2,length(href)-(I+2)+1));
|
|
i:=chmindex.indexof(filename);
|
|
if i<>-1 then
|
|
begin
|
|
{$ifdef wdebug}
|
|
debugmessageS({$i %file%},'TCHMWrapper: resolving '+filename+' '+inttostr(i),{$i %line%},'1',0,0);
|
|
debugmessageS({$i %file%},'TCHMWrapper: resolving '+restlink+' ',{$i %line%},'1',0,0);
|
|
{$endif}
|
|
chmw:=TCHMWrapper(chmindex.objects[i]);
|
|
Afileid:=chmw.fileid;
|
|
alinkid:=chmw.fTopicLinks.additem(restlink);
|
|
result:=true;
|
|
end;
|
|
end;
|
|
end
|
|
end;
|
|
|
|
function stringreplace(const s:ansistring;const oldstr:ansistring; const newstr:ansistring):ansistring;
|
|
|
|
begin
|
|
result:=sysutils.stringreplace(s,oldstr,newstr,[rfreplaceall]);
|
|
end;
|
|
initialization
|
|
ChmIndex:=TStringlist.create;
|
|
ChmIndex.sorted:=true;
|
|
finalization
|
|
ChmIndex.Free;
|
|
end.
|