fpc/ide/wchmhwrap.pas

{
    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;
                     public
                      constructor Create(name:String);
                      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;

implementation

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);

begin
  ffs:=Classes.TFileStream.create(name,fmOpenRead);
  fchmr:=TChmReader.Create(ffs,True); // owns ffs
  findex:=nil;
  if not fchmr.isvalidfile then
    begin
      freeandnil(fchmr);
      freeandnil(ffs);
      exit;
    end;
  {$ifdef wdebug}
    debugmessageS({$i %file%},'TCHMWrapper: before sitemap creation ',{$i %line%},'1',0,0);
  {$endif}
  findex:=TChmSiteMap.create(stindex);
  ftopic:=TChmSiteMap.create(sttoc);
  {$ifdef wdebug}
    debugmessageS({$i %file%},'TCHMWrapper: after sitemap creation ',{$i %line%},'1',0,0);
  {$endif}
  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;
begin
 result:=false;
 if not assigned (fchmr) then exit;
 if floaded then exit;
 {$ifdef wdebug}
     debugmessageS({$i %file%},'TCHMWrapper: indexfilename:'+fchmr.indexfile,{$i %line%},'1',0,0);
 {$endif}

  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));
  for i:=0 to findex.items.count-1 do
    begin
      item:=findex.items.item[i];
      tli:=TopicLinks^.AddItem('/'+item.local);
      TLI:=EncodeHTMLCtx(ID,TLI+1);
      IndexEntries^.Insert(NewIndexEntry(  FormatAlias(item.text),ID,TLI));
    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;

begin
  freeandnil(ftopic);
  freeandnil(findex);
  freeandnil(fchmr);
end;
// m:=r.getobject(r.indexfile);
//  siteindex.loadfromStream(m);

end.