paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 09:26:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

* initial ms-its: cross chm linking support.

Browse Source 
git-svn-id: trunk@13638 -
This commit is contained in:
marco 2009-09-02 20:54:06 +00:00
parent b93ff4c71c
commit fe20d5546e
2 changed files with 114 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
ide/wchmhwrap.pas
View File

@ -25,22 +25,29 @@ Type
TChmWrapper = Class TChmWrapper = Class
private private
ffs : Classes.TFileStream; ffs : Classes.TFileStream;
fchmr : TChmReader; fchmr : TChmReader;
findex: TChmSiteMap; findex : TChmSiteMap;
ftopic: TChmSiteMap; ftopic : TChmSiteMap;
floaded : boolean; floaded : boolean;
fileid : integer;
fshortname : string;
flongname : string;
fTopicLinks : PTopicLinkCollection;
public public
constructor Create(name:String); constructor Create(name:String;aid:integer;TopicLinks:PTopicLinkCollection);
function LoadIndex(id:integer;TopicLinks: PTopicLinkCollection;IndexEntries : PUnsortedIndexEntryCollection;helpfacility:PHelpFacility):boolean; function LoadIndex(id:integer;TopicLinks: PTopicLinkCollection;IndexEntries : PUnsortedIndexEntryCollection;helpfacility:PHelpFacility):boolean;
function GetTopic(name:string):PMemoryTextFile; function GetTopic(name:string):PMemoryTextFile;
destructor Destroy;override; destructor Destroy;override;
end; end;
function combinepaths(relpath,basepath:String):String; function combinepaths(relpath,basepath:String):String;
function CHMResolve( href: ansistring; var AFileId,ALinkId : longint):boolean;
implementation implementation
var CHMIndex : TStringList; // list to register open CHMs.
function combinepaths(relpath,basepath:String):String; function combinepaths(relpath,basepath:String):String;
begin begin
@ -72,27 +79,28 @@ begin
result:=basepath+relpath; result:=basepath+relpath;
end; end;
Constructor TChmWrapper.Create(name:string;aid:integer;TopicLinks:PTopicLinkCollection);
Constructor TChmWrapper.Create(name:string);
begin begin
ffs:=Classes.TFileStream.create(name,fmOpenRead or fmsharedenynone); ffs:=Classes.TFileStream.create(name,fmOpenRead or fmsharedenynone);
fchmr:=TChmReader.Create(ffs,True); // owns ffs fchmr:=TChmReader.Create(ffs,True); // owns ffs
findex:=nil; findex:=nil;
FTopicLinks:=TopicLinks;
if not fchmr.isvalidfile then if not fchmr.isvalidfile then
begin begin
freeandnil(fchmr); freeandnil(fchmr);
freeandnil(ffs); freeandnil(ffs);
exit; exit;
end; 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} {$ifdef wdebug}
debugmessageS({$i %file%},'TCHMWrapper: before sitemap creation ',{$i %line%},'1',0,0); debugmessageS({$i %file%},'TCHMWrapper.Create: before sitemap creation '+fshortname+' id='+inttostr(aid),{$i %line%},'1',0,0);
{$endif} {$endif}
findex:=TChmSiteMap.create(stindex); findex:=TChmSiteMap.create(stindex);
ftopic:=TChmSiteMap.create(sttoc); ftopic:=TChmSiteMap.create(sttoc);
{$ifdef wdebug}
debugmessageS({$i %file%},'TCHMWrapper: after sitemap creation ',{$i %line%},'1',0,0);
{$endif}
floaded:=false; floaded:=false;
end; end;
@ -113,8 +121,8 @@ var
tli: integer; tli: integer;
begin begin
result:=false; result:=false;
if not assigned (fchmr) then exit;
if floaded then exit; if floaded then exit;
if not assigned (fchmr) then exit;
{$ifdef wdebug} {$ifdef wdebug}
debugmessageS({$i %file%},'TCHMWrapper: indexfilename:'+fchmr.indexfile,{$i %line%},'1',0,0); debugmessageS({$i %file%},'TCHMWrapper: indexfilename:'+fchmr.indexfile,{$i %line%},'1',0,0);
{$endif} {$endif}
@ -228,10 +236,18 @@ begin
end; end;
end; end;
destructor TChmWrapper.Destroy; destructor TChmWrapper.Destroy;
var i : integer;
begin 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(ftopic);
freeandnil(findex); freeandnil(findex);
freeandnil(fchmr); freeandnil(fchmr);
@ -241,4 +257,44 @@ begin
end; 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;
initialization
ChmIndex:=TStringlist.create;
ChmIndex.sorted:=true;
finalization
ChmIndex.Free;
end. end.

48
ide/whtmlhlp.pas
View File

@ -111,6 +111,7 @@ type
procedure DocTableItem(Entered: boolean); virtual; procedure DocTableItem(Entered: boolean); virtual;
procedure DocHorizontalRuler; virtual; procedure DocHorizontalRuler; virtual;
function CanonicalizeURL(const Base,Relative:String):string; virtual; function CanonicalizeURL(const Base,Relative:String):string; virtual;
procedure Resolve( href: ansistring; var AFileId,ALinkId : sw_integer); virtual;
public public
function GetSectionColor(Section: THTMLSection; var Color: byte): boolean; virtual; function GetSectionColor(Section: THTMLSection; var Color: byte): boolean; virtual;
private private
@ -133,6 +134,7 @@ type
CurHeadLevel: integer; CurHeadLevel: integer;
PAlign: TParagraphAlign; PAlign: TParagraphAlign;
LinkIndexes: array[0..MaxTopicLinks] of sw_integer; LinkIndexes: array[0..MaxTopicLinks] of sw_integer;
FileIDLinkIndexes: array[0..MaxTopicLinks] of sw_integer;
LinkPtr: sw_integer; LinkPtr: sw_integer;
LastTextChar: char; LastTextChar: char;
{ Anchor: TAnchor;} { Anchor: TAnchor;}
@ -148,6 +150,7 @@ type
PCHMTopicRenderer = ^TCHMTopicRenderer; PCHMTopicRenderer = ^TCHMTopicRenderer;
TCHMTopicRenderer = object(THTMLTopicRenderer) TCHMTopicRenderer = object(THTMLTopicRenderer)
function CanonicalizeURL(const Base,Relative:String):string; virtual; function CanonicalizeURL(const Base,Relative:String):string; virtual;
procedure Resolve( href: ansistring; var AFileId,ALinkId : sw_integer); virtual;
end; end;
PCustomHTMLHelpFile = ^TCustomHTMLHelpFile; PCustomHTMLHelpFile = ^TCustomHTMLHelpFile;
@ -624,6 +627,7 @@ end;
procedure THTMLTopicRenderer.DocAnchor(Entered: boolean); procedure THTMLTopicRenderer.DocAnchor(Entered: boolean);
var HRef,Name: string; var HRef,Name: string;
lfileid,llinkid : sw_integer;
begin begin
if Entered and InAnchor then DocAnchor(false); if Entered and InAnchor then DocAnchor(false);
if Entered then if Entered then
@ -655,7 +659,9 @@ begin
if pos('#',HRef)=1 then if pos('#',HRef)=1 then
Href:=NameAndExtOf(GetFilename)+Href; Href:=NameAndExtOf(GetFilename)+Href;
HRef:=canonicalizeURL(URL,HRef); HRef:=canonicalizeURL(URL,HRef);
LinkIndexes[LinkPtr]:=TopicLinks^.AddItem(HRef); Resolve(Href,lfileid,llinkid);
LinkIndexes[LinkPtr]:=llinkid;
FileIDLinkIndexes[LinkPtr]:=lfileid;
{$IFDEF WDEBUG} {$IFDEF WDEBUG}
DebugMessageS({$i %file%},' Adding Link2 "'+HRef+'"',{$i %line%},'1',0,0); DebugMessageS({$i %file%},' Adding Link2 "'+HRef+'"',{$i %line%},'1',0,0);
{$ENDIF WDEBUG} {$ENDIF WDEBUG}
@ -723,6 +729,16 @@ begin
CanonicalizeURL:=CompleteURL(Base,relative); CanonicalizeURL:=CompleteURL(Base,relative);
end; end;
procedure THTMLTopicRenderer.Resolve( href: ansistring; var AFileId,ALinkId : sw_integer);
begin
{$IFDEF WDEBUG}
DebugMessageS({$i %file%},' htmlresolve "'+HRef+'"',{$i %line%},'1',0,0);
{$ENDIF WDEBUG}
Afileid:=Topic^.FileId;
ALinkId:=TopicLinks^.AddItem(HRef);
end;
procedure THTMLTopicRenderer.DocParagraph(Entered: boolean); procedure THTMLTopicRenderer.DocParagraph(Entered: boolean);
var Align: string; var Align: string;
begin begin
@ -1302,10 +1318,10 @@ begin
for I:=0 to Min(Topic^.LinkCount-1,High(LinkIndexes)-1) do for I:=0 to Min(Topic^.LinkCount-1,High(LinkIndexes)-1) do
begin begin
{$IFDEF WDEBUG} {$IFDEF WDEBUG}
DebugMessageS({$i %file%},' Indexing links ('+inttostr(i)+')'+topiclinks^.at(linkindexes[i])^,{$i %line%},'1',0,0); DebugMessageS({$i %file%},' Indexing links ('+inttostr(i)+')'+topiclinks^.at(linkindexes[i])^+' '+inttostr(i)+' '+inttostr(linkindexes[i]),{$i %line%},'1',0,0);
{$endif WDEBUG} {$endif WDEBUG}
Topic^.Links^[I].FileID:=Topic^.FileID; Topic^.Links^[I].FileID:=FileIDLinkIndexes[i];
Topic^.Links^[I].Context:=EncodeHTMLCtx(Topic^.FileID,LinkIndexes[I]+1); Topic^.Links^[I].Context:=EncodeHTMLCtx(FileIDLinkIndexes[i],LinkIndexes[I]+1);
end; end;
{$IFDEF WDEBUG} {$IFDEF WDEBUG}
if Topic^.Linkcount>High(linkindexes) then if Topic^.Linkcount>High(linkindexes) then
@ -1336,6 +1352,28 @@ begin
CanonicalizeUrl:=relative; CanonicalizeUrl:=relative;
end; end;
procedure TCHMTopicRenderer.Resolve( href: ansistring; var AFileId,ALinkId : sw_integer);
var resolved:boolean;
begin
{$IFDEF WDEBUG}
DebugMessageS({$i %file%},' chmresolve "'+HRef+'"',{$i %line%},'1',0,0);
{$ENDIF WDEBUG}
resolved:=false;
if copy(href,1,7)='ms-its:' then
resolved:=CHMResolve(Href,AFileId,ALinkID);
if not resolved then
begin
{$IFDEF WDEBUG}
DebugMessageS({$i %file%},' chmresolve not resolved "'+HRef+'"',{$i %line%},'1',0,0);
{$ENDIF WDEBUG}
Afileid:=Topic^.FileId;
ALinkId:=TopicLinks^.AddItem(HRef);
end;
end;
constructor TCustomHTMLHelpFile.Init(AID: word); constructor TCustomHTMLHelpFile.Init(AID: word);
begin begin
inherited Init(AID); inherited Init(AID);
@ -1601,7 +1639,7 @@ begin
Fail; Fail;
end end
else else
chmw:=TCHMWrapper.Create(DefaultFileName); chmw:=TCHMWrapper.Create(DefaultFileName,AID,TopicLinks);
end; end;
function TChmHelpFile.LoadIndex: boolean; function TChmHelpFile.LoadIndex: boolean;