View Issue Details

IDProjectCategoryView StatusLast Update
0034206FPCPackagespublic2019-05-25 22:48
Reportereri0oAssigned ToMarco van de Voort 
PrioritynormalSeverityminorReproducibilityalways
Status assignedResolutionopen 
PlatformLinuxOSUbuntuOS Version16.04
Product Version3.0.4Product Buildchmcmd 
Target VersionFixed in Version 
Summary0034206: chmcmd doesn't generate an index (can't use f1)
DescriptionWe are trying to use chmcmd to generate a .chm help file from a .hhp project, but the index doesn't seem to have Keyword Index generated.

https://github.com/adventuregamestudio/ags-manual/issues/14

I couldn't understand which features of .chm files are supported.

Here it's stated it doesn't support indexes:

https://www.virtualbox.org/ticket/14520

The man pages are unfortunately too scarce

https://linux.die.net/man/1/chmcmd
Tagschm
Fixed in Revision
FPCOldBugId
FPCTarget
Attached Files
  • chm_fixes.patch (3,594 bytes)
    Index: packages/chm/src/chmfilewriter.pas
    ===================================================================
    --- packages/chm/src/chmfilewriter.pas	(revision 39308)
    +++ packages/chm/src/chmfilewriter.pas	(working copy)
    @@ -933,6 +933,8 @@
                            Error(ChmWarning,'Found file '+s+' while scanning '+fn+', but couldn''t find it on disk',2);
                      end;
                  except
    +               on e:EDomError do
    +                  Error(ChmError,'Html parsing '+fn+', failed with a DOM error: '+e.Message);
                    on e:exception do
                       Error(ChmError,'Html parsing '+fn+', failed. Please submit a bug.');
                    end;
    @@ -943,6 +945,29 @@
                  Error(chmnote,'Can''t find file '+fn+' to scan it.',5);
                end;
             end
    +     else if FileExists(fn) and (uppercase(ExtractFileExt(fn))='.CSS') then
    +       begin
    +         tmplst:=TStringList.Create;
    +         try
    +           tmplst.LoadFromFile(fn);
    +
    +           for i:=0 to tmplst.Count-1 do
    +             begin
    +               s:=tmplst[i];
    +               if pos('url(''', tmplst[i])>0 then
    +                 begin
    +                   delete(s,1,pos('url(''', tmplst[i])+4);
    +                   s:=trim(copy(s,1,pos('''',s)-1));
    +
    +                   if not trypath(s) then
    +//                     if not trypath(localpath+s) then
    +                       Error(ChmWarning,'Found file '+s+' while scanning '+fn+', but couldn''t find it on disk',2);
    +                 end;
    +             end;
    +         finally
    +           tmplst.Free;
    +         end;
    +       end
          else
            Error(chmnote,'Not scanning file because of unknown extension '+fn,5);
        end;
    Index: packages/chm/src/chmsitemap.pas
    ===================================================================
    --- packages/chm/src/chmsitemap.pas	(revision 39308)
    +++ packages/chm/src/chmsitemap.pas	(working copy)
    @@ -169,8 +169,15 @@
     end;
     
     procedure TChmSiteMap.FoundTag(ACaseInsensitiveTag, AActualTag: string);
    +    procedure NewSiteMapItem;
    +    begin
    +      FCurrentItems.Add(TChmSiteMapItem.Create(FCurrentItems));
    +    end;
         function ActiveItem: TChmSiteMapItem;
         begin
    +      if FCurrentItems.Count=0 then
    +        NewSiteMapItem;
    +
           Result := FCurrentItems.Item[FCurrentItems.Count-1]
         end;
         procedure IncreaseULevel;
    @@ -189,10 +196,6 @@
           else FCurrentItems := nil;
           Dec(FLevel);
         end;
    -    procedure NewSiteMapItem;
    -    begin
    -      FCurrentItems.Add(TChmSiteMapItem.Create(FCurrentItems));
    -    end;
     var
       TagName,
       //TagAttribute,
    Index: packages/chm/src/htmlindexer.pas
    ===================================================================
    --- packages/chm/src/htmlindexer.pas	(revision 39308)
    +++ packages/chm/src/htmlindexer.pas	(working copy)
    @@ -216,6 +216,10 @@
     begin
       if Length(Text) < 1 then
         Exit;
    +
    +  if (not FInTitle) and (not FInBody) then
    +    Exit;
    +
       EatWords(Text, FInTitle and not FInBody);
     end;
     
    @@ -278,7 +282,7 @@
         WordName := Copy(WordStart, 0, (WordPtr-WordStart));
         try
         WordIndex := addgetword(wordname,istitle); // Self.Words[WordName, IsTitle];
    -    except on e:exception do writeln(wordname); end;
    +    except on e:exception do writeln('Error: ', wordname); end;
         WordIndex.DocumentTopic[FTopicIndex].AddWordIndex(FWordCount);
         InWord := False;
         //if IsNumberWord then WriteLn('Following is NUMBER WORD: "', (WordStart[0]),'"'); ;
    @@ -497,7 +501,7 @@
     
     function TIndexDocument.getindexentries:integer;
     begin
    - result:=flastentry-1; 
    + result:=flastentry;
     end;
     
     end.
    
    chm_fixes.patch (3,594 bytes)
  • hhex2.pp (1,147 bytes)
    Program hhex2;
    {$mode delphi}
    {
       Small example/test of the html help OCX.
       Marco van de Voort (C) 2009
    
       Copy rtl.chm from the CHM distribution to this dir. Test keyword/alink search.
    }
    
    Uses HTMLHelp;
    
    var
       keyword      : ansistring; 
       HelpfileName : AnsiString;
       htmltopic    : AnsiString;
       res 		: Integer;
       ah           : PHH_AKLINK ;
       
    Begin
      Helpfilename:='AGSHelpdoc.chm';
      keyword:='Setting up the game' ;
     
      New(ah);
      fillchar(ah^,sizeof(ah^),#0); 
      ah.cbstruct:=sizeof(tagHH_AKLINK);
      ah.fReserved   := FALSE ;
      ah.pszKeywords :=pansichar(keyword);  
      ah.pszUrl      := NIL ;
      ah.pszMsgText  :='Text succes' ;
      ah.pszMsgTitle :='Text fail';
      ah.pszWindow   := NIL ;
      ah.fIndexOnFail:= false;
    
     
      Res:=HtmlHelpA(0,pchar(helpfilename) ,HH_DISPLAY_INDEX,PTRUINT(PAnsiChar(Keyword)));	
    
      // keyword search seems to have same effect.
      Res:=HtmlHelpA(0,pchar(helpfilename) ,HH_ALINK_LOOKUP,PTRUINT(AH));	
      writeln(ah.pszkeywords);
      writeln(ah.pszurl);
      writeln(ah.pszmsgtext);
      writeln(ah.pszmsgtitle);
      writeln(ah.pszwindow);
      writeln(res);
    
     readln;
    end.
    
    hhex2.pp (1,147 bytes)
  • hhex3.pp (1,109 bytes)
    Program hhex2;
    {$mode delphi}
    {
       Small example/test of the html help OCX.
       Marco van de Voort (C) 2009
    
       Copy rtl.chm from the CHM distribution to this dir. Test keyword/alink search.
    }
    
    Uses HTMLHelp;
    
    var
       keyword      : ansistring; 
       HelpfileName : AnsiString;
       htmltopic    : AnsiString;
       res 		: Integer;
       ah           : PHH_AKLINK ;
       
    Begin
      Helpfilename:='AGSHelpdoc.chm';
      keyword:='Arrays' ;
     
      New(ah);
      fillchar(ah^,sizeof(ah^),#0); 
      ah.cbstruct:=sizeof(tagHH_AKLINK);
      ah.fReserved   := FALSE ;
      ah.pszKeywords :=pansichar(keyword);  
      ah.pszUrl      := NIL ;
      ah.pszMsgText  :='Text succes' ;
      ah.pszMsgTitle :='Text fail';
      ah.pszWindow   := NIL ;
      ah.fIndexOnFail:= true;
    
     
      Res:=HtmlHelpA(0,pchar(helpfilename) ,HH_DISPLAY_TOPIC,0);	
    
      // keyword search seems to have same effect.
      Res:=HtmlHelpA(0,pchar(helpfilename) ,HH_KEYWORD_LOOKUP,PTRUINT(AH));	
      writeln(ah.pszkeywords);
      writeln(ah.pszurl);
      writeln(ah.pszmsgtext);
      writeln(ah.pszmsgtitle);
      writeln(ah.pszwindow);
      writeln(res);
    
     readln;
    end.
    
    hhex3.pp (1,109 bytes)
  • chmworking.patch (57,390 bytes)
    Index: packages/chm/fpmake.pp
    ===================================================================
    --- packages/chm/fpmake.pp	(revision 42090)
    +++ packages/chm/fpmake.pp	(working copy)
    @@ -31,6 +31,7 @@
     
         D:=P.Dependencies.Add('fcl-xml');
         D:=P.Dependencies.Add('fcl-base');
    +    D:=P.Dependencies.Add('rtl-generics');
         D.Version:='3.3.1';
     
         P.SourcePath.Add('src');
    Index: packages/chm/src/chmcmd.lpr
    ===================================================================
    --- packages/chm/src/chmcmd.lpr	(revision 42090)
    +++ packages/chm/src/chmcmd.lpr	(working copy)
    @@ -145,7 +145,7 @@
       else
         begin
          try
    -      project.ScanHtmlContents:=htmlscan=scanforce;  // .hhp default SCAN
    +      project.ScanHtmlContents:=htmlscan in [scanforce, scandefault];  // .hhp default SCAN
           Project.LoadFromFile(name);
          except
            on e:exception do
    @@ -166,7 +166,6 @@
         end;
       OutStream.Free;
       Project.Free;
    -
     end;
     
     var
    Index: packages/chm/src/chmfilewriter.pas
    ===================================================================
    --- packages/chm/src/chmfilewriter.pas	(revision 42090)
    +++ packages/chm/src/chmfilewriter.pas	(working copy)
    @@ -926,7 +926,7 @@
                    scantags(domdoc,extractfilename(fn),localfilelist);
                    for i:=0 to localFilelist.count-1 do
                      begin
    -                   s:=localfilelist[i];
    +                   s:=localfilelist[i];                   
                        if not trypath(s) then
     //                     if not trypath(localpath+s) then
                            Error(ChmWarning,'Found file '+s+' while scanning '+fn+', but couldn''t find it on disk',2);
    @@ -984,8 +984,9 @@
     
     procedure scanitems(it:TChmSiteMapItems);
     
    -var i : integer;
    +var i,j : integer;
         x : TChmSiteMapItem;
    +    si  : TChmSiteMapSubItem;
         s : string;
         strrec : TStringIndex;
     
    @@ -993,7 +994,10 @@
       for i:=0 to it.count -1 do
         begin
           x:=it.item[i];
    -      if sanitizeurl(fbasepath,x.local,'','Site Map for '+x.Text,S) then   // sanitize, remove stuff etc.
    +      for j:=0 to x.SubItemcount-1 do
    +         begin
    +           si:=x.SubItem[j];
    +      if sanitizeurl(fbasepath,si.local,'','Site Map for '+x.Text,S) then   // sanitize, remove stuff etc.
             begin
               if not FileInTotalList(uppercase(s)) then
                 begin
    @@ -1014,7 +1018,7 @@
             end
           else
            Error(chmnote,'Bad url: '+s+'.',5);
    -
    +         end;
           if assigned(x.children) and (x.children.count>0) then
             scanitems(x.children);
         end;
    @@ -1213,6 +1217,7 @@
               FIndex:=TChmSiteMap.Create(stindex);
               FIndex.loadfromfile(FIndexFileName);
               Error(chmnote,'Index items:'+inttostr(findex.Items.count));
    +          findex.SaveToFile('dummy.hhk');
             except
               on e: Exception do
                 begin
    Index: packages/chm/src/chmreader.pas
    ===================================================================
    --- packages/chm/src/chmreader.pas	(revision 42090)
    +++ packages/chm/src/chmreader.pas	(working copy)
    @@ -20,15 +20,17 @@
     }
     unit chmreader;
     
    -{$mode objfpc}{$H+}
    +{$mode delphi}
     
     //{$DEFINE CHM_DEBUG}
     { $DEFINE CHM_DEBUG_CHUNKS}
    -
    +{$define binindex}
    +{$define nonumber}
     interface
     
     uses
    -  Classes, SysUtils, Contnrs, chmbase, paslzx, chmFIftiMain, chmsitemap;
    +  Generics.Collections, Classes, SysUtils,  Contnrs,
    +  chmbase, paslzx, chmFIftiMain, chmsitemap;
     
     type
     
    @@ -729,7 +731,7 @@
       PMGIndex: Integer;
       {$ENDIF}
     begin
    -  if ForEach = nil then Exit;
    +  if not assigned(ForEach) then Exit;
       ChunkStream := TMemoryStream.Create;
       {$IFDEF CHM_DEBUG_CHUNKS}
       WriteLn('ChunkCount = ',fDirectoryHeader.DirectoryChunkCount);
    @@ -970,6 +972,10 @@
         fTOPICSStream.ReadDWord;
         TopicTitleOffset := LEtoN(fTOPICSStream.ReadDWord);
         TopicURLTBLOffset := LEtoN(fTOPICSStream.ReadDWord);
    +    {$ifndef nonumber}
    +    writeln('titleid:',TopicTitleOffset);
    +    writeln('urlid  :',TopicURLTBLOffset);
    +    {$endif}
         if TopicTitleOffset <> $FFFFFFFF then
           ATitle := ReadStringsEntry(TopicTitleOffset);
          //WriteLn('Got a title: ', ATitle);
    @@ -1016,7 +1022,10 @@
       result:=head<tail;
     
       n:=head-oldhead;
    -  if (n>0) and (oldhead[n-1]=0) then dec(n); // remove trailing #0
    +
    +  pw:=pword(@oldhead[n]);
    +  if (n>1) and (pw[-1]=0) then dec(n,2); // remove trailing #0
    +//  writeln(n);
       setlength(ws,n div sizeof(widechar));
       move(oldhead^,ws[1],n);
       for n:=1 to length(ws) do
    @@ -1024,11 +1033,16 @@
       readv:=ws; // force conversion for now, and hope it doesn't require cwstring
     end;
     
    +
    +Type TLookupRec = record
    +                   item : TChmSiteMapItems;
    +                   depth : integer;
    +                   end;
    +     TLookupDict = TDictionary<string,TLookupRec>;
     function TChmReader.GetIndexSitemap(ForceXML:boolean=false): TChmSiteMap;
     var Index   : TMemoryStream;
    -    sitemap : TChmSiteMap;
    -    Item    : TChmSiteMapItem;
     
    +
     function  AbortAndTryTextual:tchmsitemap;
     
     begin
    @@ -1045,7 +1059,7 @@
           result:=nil;
     end;
     
    -procedure createentry(Name:ansistring;CharIndex:integer;Topic,Title:ansistring);
    +{function createentry(Name:ansistring;CharIndex:integer;Topic,Title:ansistring):TChmSiteMapItem;
     var litem : TChmSiteMapItem;
         shortname : ansistring;
         longpart  : ansistring;
    @@ -1053,6 +1067,7 @@
      if charindex=0 then
        begin
          item:=sitemap.items.NewItem;
    +     item.addname(name);
          item.keyword:=Name;
          item.local:=topic;
          item.text:=title;
    @@ -1065,7 +1080,7 @@
            begin
              litem:=item.children.newitem;
              litem.local:=topic;
    -         litem.keyword :=longpart; // recursively split this? No examples.
    +         litem.keyword :=longpart; // recursively split this? No examples. ->akelpad.chm
              litem.text:=title;
            end
           else
    @@ -1089,32 +1104,49 @@
          item.KeyWord:=name;
          item.SeeAlso:=seealso;
     end;
    +}
    +var
    +   parentitem:TChmSiteMapItems;
    +   itemstack :TObjectList;
    +   lookup  : TLookupDict;
    +   curitemdepth : integer;
    +   sitemap : TChmSiteMap;
     
    +function getitem(anentrydepth:integer):Tchmsitemapitems;
    +begin
    +   if anentrydepth<itemstack.count then
    +     result:=tchmsitemapitems(itemstack[anentrydepth])
    +   else
    +     begin
    +       {$ifdef binindex}
    +         writeln('pop from emptystack at ',anentrydepth,' ',itemstack.count);
    +       {$endif}
    +       result:=tchmsitemapitems(itemstack[itemstack.Count-1]);
    +     end;
    +end;
     
    +procedure pushitem(anentrydepth:integer;anitem:tchmsitemapitem);
    +begin
    +
    + if anentrydepth<itemstack.count then
    +   itemstack[anentrydepth]:=anitem.children
    + else
    +   if anentrydepth=itemstack.count then
    +     itemstack.add(anitem.Children)
    +   else
    +     begin
    +       {$ifdef binindex}
    +         writeln('push more than 1 larger ' ,anentrydepth,' ',itemstack.count);
    +       {$endif}
    +       itemstack.add(anitem.Children)
    +     end;
    +end;
     procedure parselistingblock(p:pbyte);
     var
    -    itemstack:TObjectStack;
    -    curitemdepth : integer;
    -    parentitem:TChmSiteMap;
     
    -procedure updateparentitem(entrydepth:integer);
    -begin
    -  if entrydepth>curitemdepth then
    -    begin
    -      if curitemdepth<>0 then
    -        itemstack.push(parentitem);
    -      curitemdepth:=entrydepth;
    -    end
    -  else
    -   if entrydepth>curitemdepth then
    -    begin
    -      if curitemdepth<>0 then
    -        itemstack.push(parentitem);
    -      curitemdepth:=entrydepth;
    -    end
    -end;
    +    Item    : TChmSiteMapItem;
     
    -var hdr:PBTreeBlockHeader;
    +    hdr:PBTreeBlockHeader;
         head,tail : pbyte;
         isseealso,
         entrydepth,
    @@ -1125,9 +1157,42 @@
         CharIndex,
         ind:integer;
         seealsostr,
    -    topic,
    +    s,
         Name : AnsiString;
    +    path,
    +    shortname : AnsiString;
    +    anitem:TChmSiteMapItems;
    +    litem : TChmSiteMapItem;
    +    lookupitem : TLookupRec;
    +
    +function readvalue:string;
     begin
    +  if head<tail Then
    +    begin
    +      ind:=LEToN(plongint(head)^);
    +
    +      result:=lookuptopicbyid(ind,title);
    +      {$ifdef binindex}
    +        writeln(i:3,' topic: ' {$ifndef nonumber},'  (',ind,')' {$endif});
    +        writeln('    title: ',title);
    +        writeln('    result: ',result);
    +      {$endif}
    +      inc(head,4);
    +    end;
    +end;
    +
    +procedure dumpstack;
    +var fp : TChmSiteMapItems;
    +     ix : Integer;
    +begin
    +  for ix:=0 to itemstack.Count-1 do
    +    begin
    +      fp :=TChmSiteMapItems(itemstack[ix]);
    +      writeln(ix:3,' ',fp.parentname);
    +    end;
    +end;
    +
    +begin
       //setlength (curitem,10);
       hdr:=PBTreeBlockHeader(p);
       hdr^.Length          :=LEToN(hdr^.Length);
    @@ -1135,17 +1200,19 @@
       hdr^.IndexOfPrevBlock:=LEToN(hdr^.IndexOfPrevBlock);
       hdr^.IndexOfNextBlock:=LEToN(hdr^.IndexOfNextBlock);
     
    +  writeln('hdr:',hdr^.length);
       tail:=p+(2048-hdr^.length);
       head:=p+sizeof(TBtreeBlockHeader);
     
    -  itemstack:=TObjectStack.create;
       {$ifdef binindex}
    +  {$ifndef nonumber}
       writeln('previndex  : ',hdr^.IndexOfPrevBlock);
       writeln('nextindex  : ',hdr^.IndexOfNextBlock);
       {$endif}
    -  curitemdepth:=0;
    +  {$endif}
       while head<tail do
         begin
    +      //writeln(tail-head);
           if not ReadWCharString(Head,Tail,Name) Then
             Break;
           {$ifdef binindex}
    @@ -1158,6 +1225,69 @@
           IsSeealso:=LEToN(PE^.isseealso);
           EntryDepth:=LEToN(PE^.entrydepth);
           CharIndex:=LEToN(PE^.CharIndex);
    +      Path:='';
    +
    +      if charindex<>0 then
    +        begin
    +          Path:=Trim(Copy(Name,1,charindex-2));
    +          Shortname:=trim(copy(Name,charindex,Length(Name)-Charindex+1));
    +        end
    +      else
    +        shortname:=name;
    +      writeln('depth:', curitemdepth, ' ' ,entrydepth);
    +      if curitemdepth=entrydepth then // same level, so of same parent
    +         begin
    +           item:=parentitem.newitem;
    +           pushitem(entrydepth+1,item);
    +         end
    +      else
    +        if curitemdepth=entrydepth-1 then // new child, one lower.
    +          begin
    +            parentitem:=getitem(entrydepth);
    +            item:=parentitem.newitem;
    +            pushitem(entrydepth+1,item);
    +          end
    +        else
    +         if entrydepth<curitemdepth then
    +          begin
    +            parentitem:=getitem(entrydepth);
    +            writeln('bingo!', parentitem.parentname);
    +            dumpstack;
    +            item:=parentitem.newitem;
    +            pushitem(entrydepth+1,item);
    +          end;
    +
    +      curitemdepth:=entrydepth;
    +      writeln('lookup:', Name, ' = ', path,' = ',shortname);
    +
    +    (*  if lookup.trygetvalue(path,lookupitem) then
    +        begin
    +//          if lookupitem.item<>parentitem then
    +//             writeln('mismatch: ',lookupitem.item.item[0].name,' ',name);
    +{          if curitemdepth<entrydepth then
    +            begin
    +              writeln('lookup ok!',curitemdepth,' ' ,entrydepth);
    +              curitemdepth:=entrydepth;
    +            end
    +          else
    +           begin
    +             writeln('lookup odd!',curitemdepth,' ' ,entrydepth);
    +           end;
    +          curitemdepth:=lookupitem.depth+1;
    +          parentitem:=lookupitem.item;}
    +        end
    +      else
    +        begin
    + //            parentitem:=sitemap.Items;
    +          if not curitemdepth=entrydepth then
    +             writeln('no lookup odd!',curitemdepth,' ' ,entrydepth);
    +        end;  *)
    +{      item:=parentitem.newitem;}
    +      lookupitem.item:=item.children;
    +      lookupitem.depth:=entrydepth;
    +      lookup.addorsetvalue(name,lookupitem);
    +      item.AddName(Shortname);
    +
           {$ifdef binindex}
             Writeln('seealso   :  ',IsSeeAlso);
             Writeln('entrydepth:  ',EntryDepth);
    @@ -1178,7 +1308,7 @@
               {$ifdef binindex}
                 writeln('seealso: ',seealsostr);
               {$endif}
    -
    +          item.AddSeeAlso(seealsostr);
             end
           else
             begin
    @@ -1190,24 +1320,13 @@
     
                 for i:=0 to nrpairs-1 do
                   begin
    -                if head<tail Then
    -                  begin
    -                    ind:=LEToN(plongint(head)^);
    -                    topic:=lookuptopicbyid(ind,title);
    -                    {$ifdef binindex}
    -                      writeln(i:3,' topic: ',topic);
    -                      writeln('    title: ',title);
    -                    {$endif}
    -                    inc(head,4);
    -                  end;
    +               s:=readvalue;
    +             //  if not ((i=0) and (title=shortname)) then
    +               item.addname(title);
    +               item.addlocal(s);
                   end;
               end;
              end;
    -      if isseealso>0 then
    -         createentryseealso(name,charindex,seealsostr)
    -      else
    -        if nrpairs<>0 Then
    -          createentry(Name,CharIndex,Topic,Title);
           inc(head,4); // always 1
           {$ifdef binindex}
             if head<tail then
    @@ -1215,7 +1334,6 @@
           {$endif}
           inc(head,4); // zero based index (13 higher than last
         end;
    -  ItemStack.Free;
     end;
     
     var TryTextual : boolean;
    @@ -1222,8 +1340,10 @@
         BHdr       : TBTreeHeader;
         block      : Array[0..2047] of Byte;
         i          : Integer;
    +
     begin
        Result := nil;  SiteMap:=Nil;
    +   lookup:=TDictionary<string,TLookupRec>.create;
        // First Try Binary
        Index := GetObject('/$WWKeywordLinks/BTree');
        if (Index = nil) or ForceXML then
    @@ -1237,9 +1357,12 @@
          Exit;
        end;
        SiteMap:=TChmSitemap.Create(StIndex);
    -   Item   :=Nil;  // cached last created item, in case we need to make
    +   itemstack :=TObjectList.create(false);
    +   //Item   :=Nil;  // cached last created item, in case we need to make
                       // a child.
    -
    +   parentitem:=sitemap.Items;
    +   itemstack.add(parentitem); // level 0
    +   curitemdepth:=0;
        TryTextual:=True;
        BHdr.LastLstBlock:=0;
        if LoadBtreeHeader(index,BHdr) and (BHdr.LastLstBlock>=0) Then
    @@ -1248,7 +1371,7 @@
              begin
                for i:=0 to BHdr.lastlstblock do
                  begin
    -               if (index.size-index.position)>=defblocksize then
    +               if (index.size-index.position)>=defblocksize then // skips last incomplete block?
                      begin
                        Index.read(block,defblocksize);
                        parselistingblock(@block)
    @@ -1264,6 +1387,7 @@
           Result:=AbortAndTryTextual;
         end
       else Index.Free;
    +  lookup.free;
     end;
     
     function TChmReader.GetTOCSitemap(ForceXML:boolean=false): TChmSiteMap;
    @@ -1279,13 +1403,12 @@
           Item := SiteMapITems.NewItem;
           Props := LEtoN(TOC.ReadDWord);
           if (Props and TOC_ENTRY_HAS_LOCAL) = 0 then
    -        Item.Text:= ReadStringsEntry(LEtoN(TOC.ReadDWord))
    +        Item.AddName(ReadStringsEntry(LEtoN(TOC.ReadDWord)))
           else
           begin
             TopicsIndex := LEtoN(TOC.ReadDWord);
    -        Item.Local := LookupTopicByID(TopicsIndex, Title);
    -        Item.Text := Title;
    -
    +        Item.AddName(title);
    +        Item.addLocal(LookupTopicByID(TopicsIndex, Title));
           end;
           TOC.ReadDWord;
           Result := LEtoN(TOC.ReadDWord);
    @@ -1724,7 +1847,7 @@
       X: Integer;
     begin
       fOnOpenNewFile := AValue;
    -  if AValue = nil then exit;
    +  if not assigned(AValue)  then exit;
       for X := 0 to fUnNotifiedFiles.Count-1 do
         AValue(Self, X);
       fUnNotifiedFiles.Clear;
    Index: packages/chm/src/chmsitemap.pas
    ===================================================================
    --- packages/chm/src/chmsitemap.pas	(revision 42090)
    +++ packages/chm/src/chmsitemap.pas	(working copy)
    @@ -20,19 +20,63 @@
     }
     unit chmsitemap;
     
    -{$mode objfpc}{$H+}
    -
    +{$mode Delphi}{$H+}
    +{define preferlower}
     interface
     
     uses
    -  Classes, SysUtils, fasthtmlparser;
    +  Classes, SysUtils, fasthtmlparser, contnrs, strutils, generics.collections;
     
     type
       TChmSiteMapItems = class; // forward
       TChmSiteMap = class;
    +  TChmSiteMapItem = class;
     
       { TChmSiteMapItem }
     
    +  TChmSiteMapItemAttrName = (siteattr_NONE,
    +                             siteattr_KEYWORD, // alias for name in sitemap
    +                             siteattr_NAME,
    +                             siteattr_LOCAL,
    +                             siteattr_URL,
    +                             siteattr_TYPE,
    +                             siteattr_SEEALSO,
    +                             siteattr_IMAGENUMBER,
    +                             siteattr_NEW,
    +                             siteattr_COMMENT,
    +                             siteattr_MERGE,
    +                             siteattr_FRAMENAME,
    +                             siteattr_WINDOWNAME,
    +                             siteattr_WINDOW_STYLES,
    +                             siteattr_EXWINDOW_STYLES,
    +                             siteattr_FONT,
    +                             siteattr_IMAGELIST,
    +                             siteattr_IMAGETYPE
    +                            );
    +
    +  { TChmSiteMapSubItem }
    +  TChmSiteMapGenerationOptions = (Default,emitkeyword);
    +  TChmSiteMapSubItem = class(TPersistent)
    +  private
    +    FName,
    +    FType,
    +    FLocal,
    +    FUrl,
    +    FSeeAlso  : String;
    +    FOwner : TChmSiteMapItem;
    +  public
    +    constructor Create(AOwner: TChmSiteMapItem);
    +    destructor Destroy; override;
    +  published
    +    property Name : String read FName  write FName;  //hhk
    +    property ItemType : String read FType write FType; //both
    +    property Local: String read FLocal write FLocal; //both
    +    property URL  : String read FURL write FURL;     //both
    +    property SeeAlso: String read FSeeAlso write FSeeAlso; //hhk
    +  end;
    +
    +// hhk items:  Merge | ([Name] ([Name] [Type...] [Local [URL] | See Also])... [FrameName] [WindowName] [Comment])
    +// hhc items:  Merge | ([Name] ([Type...] [Local] [URL])... [FrameName] [WindowName] [Comment] [New] [ImageNumber])
       TChmSiteMapItem = class(TPersistent)
       private
         FChildren: TChmSiteMapItems;
    @@ -39,35 +83,41 @@
         FComment: String;
         FImageNumber: Integer;
         FIncreaseImageIndex: Boolean;
    -    FKeyWord: String;
    -    FLocal: String;
         FOwner: TChmSiteMapItems;
    -    FSeeAlso: String;
    -    FText: String;
    -    FURL: String;
    +    FName   : String;
         FMerge : String;
         FFrameName : String;
         FWindowName : String;
    +    FSubItems : TObjectList;
    +    function getlocal: string;
    +    function getseealso:string;
    +    function getsubitem( index : integer): TChmSiteMapSubItem;
    +    function getsubitemcount: integer;
         procedure SetChildren(const AValue: TChmSiteMapItems);
       public
         constructor Create(AOwner: TChmSiteMapItems);
         destructor Destroy; override;
    +    procedure AddName(const Name:string);
    +    procedure AddLocal(const Local:string);
    +    procedure AddSeeAlso(const SeeAlso:string);
    +    procedure AddURL(const URL:string);
    +    procedure AddType(const AType:string);
    +    procedure Sort(Compare: TListSortCompare);
       published
         property Children: TChmSiteMapItems read FChildren write SetChildren;
    -    property Text: String read FText write FText; // Name for TOC; KeyWord for index
    -    property KeyWord: String read FKeyWord write FKeyWord;
    -    property Local: String read FLocal write FLocal;
    -    property URL: String read FURL write FURL;
    -    property SeeAlso: String read FSeeAlso write FSeeAlso;
    +    property Name: String read FName write FName;
         property ImageNumber: Integer read FImageNumber write FImageNumber default -1;
         property IncreaseImageIndex: Boolean read FIncreaseImageIndex write FIncreaseImageIndex;
         property Comment: String read FComment write FComment;
         property Owner: TChmSiteMapItems read FOwner;
    -
    +    property Local : string read getlocal; // deprecated;             // should work on ALL pairs
    +    property Text : string read fname write fname; // deprecated;     // should work on ALL pairs
    +    property SeeAlso : string read getseealso; // deprecated;     // should work on ALL pairs
         property FrameName: String read FFrameName write FFrameName;
         property WindowName: String read FWindowName write FWindowName;
    -//    property Type_: Integer read FType_ write FType_; either Local or URL
         property Merge: String read FMerge write FMerge;
    +    property SubItem[ index :integer]:TChmSiteMapSubItem read getsubitem;
    +    property SubItemcount  :integer read getsubitemcount;
       end;
     
       { TChmSiteMapItems }
    @@ -80,8 +130,9 @@
         FParentItem: TChmSiteMapItem;
         function GetCount: Integer;
         function GetItem(AIndex: Integer): TChmSiteMapItem;
    +    function getparentname: String;
         procedure SetItem(AIndex: Integer; const AValue: TChmSiteMapItem);
    -  public
    +public
         constructor Create(AOwner: TChmSiteMap; AParentItem: TChmSiteMapItem);
         destructor Destroy; override;
         procedure Delete(AIndex: Integer);
    @@ -95,6 +146,7 @@
         property ParentItem: TChmSiteMapItem read FParentItem;
         property Owner: TChmSiteMap read FOwner;
         property InternalData: Dword read FInternalData write FInternalData;
    +    property ParentName : String read getparentname;
       end;
       
     
    @@ -130,7 +182,10 @@
         FLevel: Integer;
         FLevelForced: Boolean;
         FWindowStyles: LongInt;
    +    FLoadDict : TDictionary<String,TChmSiteMapItemAttrName>;
    +    fChmSiteMapGenerationOptions:TChmSiteMapGenerationOptions;
         procedure SetItems(const AValue: TChmSiteMapItems);
    +    procedure CheckLookup;
       protected
         procedure FoundTag (ACaseInsensitiveTag, AActualTag: string);
         procedure FoundText(AText: string);
    @@ -137,6 +192,7 @@
       public
         constructor Create(AType: TSiteMapType);
         destructor Destroy; override;
    +    Procedure Sort(Compare: TListSortCompare);
         procedure LoadFromFile(AFileName: String);
         procedure LoadFromStream(AStream: TStream);
         procedure SaveToFile(AFileName:String);
    @@ -155,11 +211,50 @@
         property UseFolderImages: Boolean read FUseFolderImages write FUseFolderImages;
         property Font: String read FFont write FFont;
         property AutoGenerated: Boolean read FAutoGenerated write FAutoGenerated;
    +    property ChmSiteMapGenerationOptions : TChmSiteMapGenerationOptions read fChmSiteMapGenerationOptions write fChmSiteMapGenerationOptions;
       end;
     
    +
    +function indexitemcompare(Item1, Item2: Pointer): Integer;
     implementation
     uses HTMLUtil;
     
    +const sitemapkws : array[TChmSiteMapItemAttrName] of string = (
    +                    '',
    +                    'KEYWORD',
    +                    'NAME',
    +                    'LOCAL',
    +                    'URL',
    +                    'TYPE',
    +                    'SEE ALSO',
    +                    'IMAGENUMBER',
    +                    'NEW',
    +                    'COMMENT',
    +                    'MERGE',
    +                    'FRAMENAME',
    +                    'WINDOWNAME',
    +                    'WINDOW STYLES',
    +                    'EXWINDOW STYLES',
    +                    'FONT',
    +                    'IMAGELIST',
    +                    'IMAGETYPE');
    +
    +function indexitemcompare(Item1, Item2: Pointer): Integer;
    +begin
    +    Result := naturalComparetext(LowerCase(TChmSiteMapItem(item1).name), Lowercase(TChmSiteMapItem(item2).name));
    +end;
    +{ TChmSiteMapSubItem }
    +
    +constructor TChmSiteMapSubItem.Create(AOwner: TChmSiteMapItem);
    +begin
    +  FOwner:=AOwner;
    +end;
    +
    +destructor TChmSiteMapSubItem.Destroy;
    +begin
    +  inherited Destroy;
    +end;
    +
     { TChmSiteMapTree }
     
     procedure TChmSiteMap.SetItems(const AValue: TChmSiteMapItems);
    @@ -168,6 +263,16 @@
       FItems:=AValue;
     end;
     
    +procedure TChmSiteMap.CheckLookup;
    +var en : TChmSiteMapItemAttrName;
    +begin
    +  if assigned(FLoadDict) then
    +    exit;
    +  FLoadDict :=TDictionary<String,TChmSiteMapItemAttrName>.Create;
    +  for en:=succ(low(en)) to high(en) do
    +    FLoadDict.add(sitemapkws[en],en);
    +end;
    +
     procedure TChmSiteMap.FoundTag(ACaseInsensitiveTag, AActualTag: string);
         procedure NewSiteMapItem;
         begin
    @@ -196,131 +301,101 @@
           else FCurrentItems := nil;
           Dec(FLevel);
         end;
    +
    +// hhk items:  Merge | ([Name] ([Name] [Type...] [Local [URL] | See Also])... [FrameName] [WindowName] [Comment])
    +// hhc items:  Merge | ([Name] ([Type...] [Local] [URL])... [FrameName] [WindowName] [Comment] [New] [ImageNumber])
     var
       TagName,
    -  //TagAttribute,
       TagAttributeName,
       TagAttributeValue: String;
       isParam,IsMerged : string;
    +  TagAttrName  : TChmSiteMapItemAttrName;
     begin
    -  //WriteLn('TAG:', AActualTag);
       TagName := GetTagName(ACaseInsensitiveTag);
    +  //WriteLn('GOT TAG: ', AActualTag);
    +   if TagName = 'UL' then begin
    +     //WriteLN('Inc Level');
    +     IncreaseULevel;
    +   end
    +   else if TagName = '/UL' then begin
    +     //WriteLN('Dec Level');
    +     DecreaseULevel;
    +   end
    +   else if (TagName = 'LI') and (FLevel = 0) then
    +     FLevelForced := True
    +   else if TagName = 'OBJECT' then begin
    +     Include(FSiteMapBodyTags, smbtOBJECT);
    +     if FLevelForced then
    +       IncreaseULevel;
    +     If FLevel > 0 then // if it is zero it is the site properties
    +       NewSiteMapItem;
    +   end
    +   else if TagName = '/OBJECT' then begin
    +     Exclude(FSiteMapBodyTags, smbtOBJECT);
    +     if FLevelForced then
    +     begin
    +       DecreaseULevel;
    +       FLevelForced := False;
    +     end;
    +   end
    +   else begin // we are the properties of the object tag
    +     if (smbtOBJECT in FSiteMapBodyTags) then
    +       begin
    +        if (FLevel > 0 ) then
    +         begin
    +            if LowerCase(GetTagName(AActualTag)) = 'param' then begin
    +              TagAttributeName := GetVal(AActualTag, 'name');
    +              TagAttributeValue := GetVal(AActualTag, 'value');
     
    -{  if not (smtHTML in FSiteMapTags) then begin
    -    if (TagName = 'HTML') or (TagName = '/HTML') then Include(FSiteMapTags, smtHTML);
    -  end
    -  else begin // looking for /HTML
    -    if TagName = '/HTML' then Exclude(FSiteMapTags, smtHTML);
    -  end;}
    +              // a hash reduces comparisons and casing, and generics make it easy.
    +              if not FLoadDict.trygetvalue(uppercase(TagAttributeName),TagAttrName) then
    +                 TagAttrName:=siteattr_none;
     
    -  //if (smtHTML in FSiteMapTags) then begin
    -     if not (smtBODY in FSiteMapTags) then begin
    -       if TagName = 'BODY' then Include(FSiteMapTags, smtBODY);
    -     end
    -     else begin
    -       if TagName = '/BODY' then Exclude(FSiteMapTags, smtBODY);
    -     end;
    -
    -     if (smtBODY in FSiteMapTags) then begin
    -       //WriteLn('GOT TAG: ', AActualTag);
    -       if TagName = 'UL' then begin
    -         //WriteLN('Inc Level');
    -         IncreaseULevel;
    -       end
    -       else if TagName = '/UL' then begin
    -         //WriteLN('Dec Level');
    -         DecreaseULevel;
    -       end
    -       else if (TagName = 'LI') and (FLevel = 0) then
    -         FLevelForced := True
    -       else if TagName = 'OBJECT' then begin
    -         Include(FSiteMapBodyTags, smbtOBJECT);
    -         if FLevelForced then
    -           IncreaseULevel;
    -         If FLevel > 0 then // if it is zero it is the site properties
    -           NewSiteMapItem;
    -       end
    -       else if TagName = '/OBJECT' then begin
    -         Exclude(FSiteMapBodyTags, smbtOBJECT);
    -         if FLevelForced then
    -         begin
    -           DecreaseULevel;
    -           FLevelForced := False;
    -         end;
    -       end
    -       else begin // we are the properties of the object tag
    -         if (smbtOBJECT in FSiteMapBodyTags) then
    -           begin
    -            if (FLevel > 0 ) then 
    +              if TagAttrName <> siteattr_none then begin
    +                 case TagAttrName of
    +                 siteattr_KEYWORD,
    +                 siteattr_NAME         : Activeitem.AddName(TagAttributeValue);
    +                 siteattr_LOCAL        : ActiveItem.AddLocal(TagAttributeValue);
    +                 siteattr_URL          : ActiveItem.AddURL (TagAttributeValue);
    +                 siteattr_TYPE         : ActiveItem.AddType (TagAttributeValue);
    +                 siteattr_SEEALSO      : ActiveItem.AddSeeAlso(TagAttributeValue);
    +                 siteattr_IMAGENUMBER  : ActiveItem.ImageNumber := StrToInt(TagAttributeValue);
    +                 siteattr_NEW          : ActiveItem.IncreaseImageIndex := (LowerCase(TagAttributeValue) = 'yes');
    +                 siteattr_COMMENT      : ActiveItem.Comment := TagAttributeValue;
    +                 siteattr_MERGE        : ActiveItem.Merge:= TagAttributeValue;
    +                 siteattr_FRAMENAME    : ActiveItem.FrameName:=TagAttributeValue;
    +                 siteattr_WINDOWNAME   : ActiveItem.WindowName:=TagAttributeValue;
    +                 end;
    +              end;
    +            end;
    +         end
    +       else
    +         begin // object and level is zero?
    +           if LowerCase(GetTagName(AActualTag)) = 'param' then begin
                  begin
    -                if LowerCase(GetTagName(AActualTag)) = 'param' then begin
    -                  TagAttributeName := GetVal(AActualTag, 'name');
    -                TagAttributeValue := GetVal(AActualTag, 'value');
    -                //writeln('name,value',tagattributename, ' ',tagattributevalue);
    -                if TagAttributeName <> '' then begin
    -                  if CompareText(TagAttributeName, 'keyword') = 0 then begin
    -                    ActiveItem.Text := TagAttributeValue;
    -                  end
    -                  else if CompareText(TagAttributeName, 'name') = 0 then begin
    -                    if ActiveItem.Text = '' then ActiveItem.Text := TagAttributeValue;
    -                  end
    -                  else if CompareText(TagAttributeName, 'local') = 0 then begin
    -                    ActiveItem.Local := TagAttributeValue;
    -                  end
    -                  else if CompareText(TagAttributeName, 'URL') = 0 then begin
    -                    ActiveItem.URL := TagAttributeValue;
    -                  end
    -                  else if CompareText(TagAttributeName, 'ImageNumber') = 0 then begin
    -                    ActiveItem.ImageNumber := StrToInt(TagAttributeValue);
    -                  end
    -                  else if CompareText(TagAttributeName, 'New') = 0 then begin
    -                    ActiveItem.IncreaseImageIndex := (LowerCase(TagAttributeValue) = 'yes');
    -                  end
    -                  else if CompareText(TagAttributeName, 'Comment') = 0 then begin
    -                    ActiveItem.Comment := TagAttributeValue
    -                  end
    -                  else if CompareText(TagAttributeName, 'Merge') = 0 then begin
    -                    ActiveItem.Merge:= TagAttributeValue
    -                  end;
    -                  //else if CompareText(TagAttributeName, '') = 0 then begin
    -                  //end;
    -                end;
    -              end;
    -            end
    -           else
    -             begin // object and level is zero?
    -               if LowerCase(GetTagName(AActualTag)) = 'param' then begin
    -                 begin
    -                   TagAttributeName := uppercase(GetVal(AActualTag, 'name'));
    -                   TagAttributeValue := GetVal(AActualTag, 'value');
    -                   if TagAttributeName = 'FRAMENAME' then
    -                     framename:=TagAttributeValue
    -                   else
    -                     if TagAttributeName = 'WINDOWNAME' then
    -                       WINDOWname:=TagAttributeValue
    -                   else
    -                     if TagAttributeName = 'WINDOW STYLES' then
    -                       WindowStyles:=StrToIntDef(TagAttributeValue,0)
    -                   else
    -                     if TagAttributeName = 'EXWINDOW STYLES' then
    -                       ExWindowStyles:=StrToIntDef(TagAttributeValue,0)
    -                   else
    -                     if TagAttributeName = 'FONT' then
    -                       FONT:=TagAttributeValue
    -                   else
    -                     if TagAttributeName = 'IMAGELIST' then
    -                      IMAGELIST:=TagAttributeValue
    -                    else
    -                     if TagAttributeName = 'IMAGETYPE' then
    -                      UseFolderImages:=uppercase(TagAttributeValue)='FOLDER';
    -                  // writeln('0:',flevel,' ' ,aactualtag,' ',tagname,' ' ,tagattributename, ' ' ,tagattributevalue);
    -                 end;
    -                 end;
    +               TagAttributeName := uppercase(GetVal(AActualTag, 'name'));
    +               TagAttributeValue := GetVal(AActualTag, 'value');
    +               if not FLoadDict.trygetvalue(uppercase(TagAttributeName),TagAttrName) then
    +                  TagAttrName:=siteattr_none;
    +               if TagAttrName <> siteattr_none then begin
    +                  case TagAttrName of
    +                   siteattr_FRAMENAME       : FrameName:=TagAttributeValue;
    +                   siteattr_WINDOWNAME      : WindowName:=TagAttributeValue;
    +                   siteattr_WINDOW_STYLES   : WindowStyles:=StrToIntDef(TagAttributeValue,0);
    +                   siteattr_EXWINDOW_STYLES : ExWindowStyles:=StrToIntDef(TagAttributeValue,0);
    +                   siteattr_FONT            : Font:=TagAttributeValue;
    +                   siteattr_IMAGELIST       : ImageList:=TagAttributeValue;
    +                   siteattr_IMAGETYPE       : UseFolderImages:=uppercase(TagAttributeValue)='FOLDER';
    +                   end;
                  end;
    -          end;
    -       end;
    -     end;
    -  //end
    +              // writeln('0:',flevel,' ' ,aactualtag,' ',tagname,' ' ,tagattributename, ' ' ,tagattributevalue);
    +             end;
    +             end;
    +         end;
    +      end;
    +   end;
    +// end; {body}
    +  //end   {html}
     end;
     
     procedure TChmSiteMap.FoundText(AText: string);
    @@ -342,14 +417,22 @@
     begin
       if Assigned(FHTMLParser) then FHTMLParser.Free;
       FItems.Free;
    +  FLoadDict.Free;
    +
       Inherited Destroy;
     end;
     
    +procedure TChmSiteMap.Sort(Compare: TListSortCompare);
    +begin
    +  FItems.sort(compare);
    +end;
    +
     procedure TChmSiteMap.LoadFromFile(AFileName: String);
     var
       Buffer: String;
       TmpStream: TMemoryStream;
     begin
    +  CheckLookup;
       if Assigned(FHTMLParser) then FHTMLParser.Free;
       TmpStream := TMemoryStream.Create;
       try
    @@ -362,8 +445,8 @@
       end;
       FHTMLParser := THTMLParser.Create(Buffer);
       try
    -    FHTMLParser.OnFoundTag := @FoundTag;
    -    FHTMLParser.OnFoundText := @FoundText;
    +    FHTMLParser.OnFoundTag := FoundTag;
    +    FHTMLParser.OnFoundText := FoundText;
         FHTMLParser.Exec;
       finally
         FreeAndNil(FHTMLParser);
    @@ -374,12 +457,13 @@
     var
       Buffer: String;
     begin
    +  CheckLookup;
       if Assigned(FHTMLParser) then FHTMLParser.Free;
       SetLength(Buffer, AStream.Size-AStream.Position);
       if AStream.Read(Buffer[1], AStream.Size-AStream.Position) > 0 then begin;
         FHTMLParser := THTMLParser.Create(Buffer);
    -    FHTMLParser.OnFoundTag := @FoundTag;
    -    FHTMLParser.OnFoundText := @FoundText;
    +    FHTMLParser.OnFoundTag := FoundTag;
    +    FHTMLParser.OnFoundText := FoundText;
         FHTMLParser.Exec;
         FreeAndNil(FHTMLParser);
       end;
    @@ -397,6 +481,9 @@
         end;
     end;
     
    +// hhk items:  Merge | ([Name] ([Name] [Type...] [Local [URL] | See Also])... [FrameName] [WindowName] [Comment])
    +// hhc items:  Merge | ([Name] ([Type...] [Local] [URL])... [FrameName] [WindowName] [Comment] [New] [ImageNumber])
    +
     procedure TChmSiteMap.SaveToStream(AStream: TStream);
     var
       Indent: Integer;
    @@ -408,6 +495,13 @@
          AStream.Write(AString[1], Length(AString));
          AStream.WriteByte(10);
       end;
    +  procedure WriteStringNoIndent(AString: String);
    +  var
    +    I: Integer;
    +  begin
    +     AStream.Write(AString[1], Length(AString));
    +  end;
    +
       procedure WriteParam(AName: String; AValue: String);
       begin
         WriteString('<param name="'+AName+'" value="'+AValue+'">');
    @@ -414,38 +508,73 @@
       end;
       procedure WriteEntries(AItems: TChmSiteMapItems);
       var
    -    I : Integer;
    +    I,J : Integer;
         Item: TChmSiteMapItem;
    +    Sub : TChmSiteMapSubItem;
    +    lemitkeyword : boolean;
       begin
    +    lemitkeyword:=ChmSiteMapGenerationOptions=emitkeyword;
         for I := 0 to AItems.Count-1 do begin
           Item := AItems.Item[I];
    +
    +      {$ifdef preferlower}
    +      WriteString('<li> <object type="text/sitemap">');
    +      {$else}
           WriteString('<LI> <OBJECT type="text/sitemap">');
    +      {$endif}
           Inc(Indent, 8);
     
    -      if (SiteMapType = stIndex) and ((Item.Children.Count > 0) or (item.seealso<>'')) then
    -         WriteParam('Keyword', Item.Text);
    -      //if Item.KeyWord <> '' then WriteParam('Keyword', Item.KeyWord);
    -      if Item.Text <> '' then WriteParam('Name', Item.Text);
    -      if (Item.Local <> '') or (SiteMapType = stIndex) then WriteParam('Local', StringReplace(Item.Local, '\', '/', [rfReplaceAll]));
    -      if Item.URL <> '' then WriteParam('URL', StringReplace(Item.URL, '\', '/', [rfReplaceAll]));
    -      if (SiteMapType = stIndex) and (Item.SeeAlso <> '') then WriteParam('See Also', Item.SeeAlso);
    -      //if Item.FrameName <> '' then WriteParam('FrameName', Item.FrameName);
    -      //if Item.WindowName <> '' then WriteParam('WindowName', Item.WindowName);
    +      if Item.Name<>'' then
    +        begin
    +          if lemitkeyword then
    +            WriteParam('Keyword', item.Name)
    +          else
    +            WriteParam('Name', Item.Name);
    +        end;
    +
    +      if item.FSubItems.count>0 then
    +        begin
    +          For j:=0 to item.FSubItems.count-1 do
    +            begin
    +              Sub:=TChmSiteMapSubItem(item.fsubitems[j]);
    +              if Sub.Name <> ''     then WriteParam('Name', Sub.Name);
    +              if Sub.ItemType <> '' then WriteParam('Type', Sub.ItemType);
    +              if Sub.Local <> ''    then WriteParam('Local', Sub.Local);
    +              if Sub.URL <> ''      then WriteParam('URL', Sub.URL);
    +              if Sub.SeeAlso <> ''  then WriteParam('See Also', Sub.SeeAlso);
    +            end;
    +        end;
    +      if Item.FrameName <> '' then WriteParam('FrameName', Item.FrameName);
    +      if Item.WindowName <> '' then WriteParam('WindowName', Item.WindowName);
           if Item.Comment <> '' then WriteParam('Comment', Item.Comment);
    -      if (SiteMapType = stTOC) and (Item.IncreaseImageIndex) then WriteParam('New', 'yes'); // is this a correct value?
    -      if (SiteMapType = stTOC) and (Item.ImageNumber <> -1) then WriteParam('ImageNumber', IntToStr(Item.ImageNumber));
    -
    +      if (SiteMapType = stTOC) and (Item.IncreaseImageIndex) then
    +          WriteParam('New', 'yes'); // is this a correct value?
    +      if (SiteMapType = stTOC) and (Item.ImageNumber <> -1) then
    +          WriteParam('ImageNumber', IntToStr(Item.ImageNumber));
           Dec(Indent, 3);
    +      {$ifdef preferlower}
    +      WriteString('</object>');
    +      {$else}
           WriteString('</OBJECT>');
    +      {$endif}
           Dec(Indent, 5);
     
           // Now Sub Entries
           if Item.Children.Count > 0 then begin
    -        WriteString('<UL>');
    +        {$ifdef preferlower}
    +        WriteString('<ul>');
    +        {$else}
    +        WriteString('<UL> ');
    +        {$endif}
             Inc(Indent, 8);
             WriteEntries(Item.Children);
             Dec(Indent, 8);
    -        WriteString('</UL>');
    +        {$ifdef preferlower}
    +        WriteString('</ul>');
    +        {$else}
    +        WriteString('</UL>'); //writestringnoident
    +        {$endif}
    +
           end;
         end;
       end;
    @@ -501,19 +630,137 @@
       FChildren := AValue;
     end;
     
    +function TChmSiteMapItem.getlocal: string;
    +begin
    +  result:='';
    +  if FSubItems.count>0 then
    +     result:=TChmSiteMapSubItem(FSubItems[0]).local;
    +end;
    +
    +function TChmSiteMapItem.getseealso: string;
    +begin
    +  result:='';
    +  if FSubItems.count>0 then
    +    result:=TChmSiteMapSubItem(FSubItems[FSubItems.count-1]).SeeAlso;
    +end;
    +
    +function TChmSiteMapItem.getsubitem( index : integer): TChmSiteMapSubItem;
    +begin
    +  result:=nil;
    +  if index<FSubItems.count then
    +    result:=TChmSiteMapSubItem(FSubItems[index]);
    +end;
    +
    +function TChmSiteMapItem.getsubitemcount: integer;
    +begin
    +   result:=FSubItems.count;
    +end;
    +
     constructor TChmSiteMapItem.Create(AOwner: TChmSiteMapItems);
     begin
       Inherited Create;
       FOwner := AOwner;
       FChildren := TChmSiteMapItems.Create(Owner.Owner, Self);
    +  FSubItems := TObjectList.Create(true);
    +  imagenumber:=-1;
     end;
     
     destructor TChmSiteMapItem.Destroy;
     begin
    +  fsubitems.Free;
       FChildren.Free;
       Inherited Destroy;
     end;
     
    +procedure TChmSiteMapItem.AddName(const Name: string);
    +var sub :TChmSiteMapSubItem;
    +begin
    +  if fname='' then
    +    fname:=name
    +  else
    +    begin
    +      sub :=TChmSiteMapSubItem.create(self);
    +      FSubItems.add(sub);
    +      sub.Name:=Name;
    +    end;
    +end;
    +
    +procedure TChmSiteMapItem.AddLocal(const Local: string);
    +var sub :TChmSiteMapSubItem;
    +    addnew : boolean;
    +begin
    +   if fsubitems.count>0 then
    +      begin
    +        sub:=TChmSiteMapSubItem(fsubitems[FSubItems.count-1]);
    +        if sub.FLocal<>'' then
    +          begin
    +            sub.flocal:=local;
    +            exit;
    +          end;
    +      end;
    +   sub :=TChmSiteMapSubItem.create(self);
    +   FSubItems.add(sub);
    +//   sub.name:=name;
    +   sub.Local:=Local;
    +end;
    +
    +procedure TChmSiteMapItem.AddSeeAlso(const SeeAlso: string);
    +// see also is mutually exclusive with "local url", so addition procedure is same as "local"
    +var sub :TChmSiteMapSubItem;
    +begin
    +   if fsubitems.count>0 then
    +      begin
    +        sub:=TChmSiteMapSubItem(fsubitems[FSubItems.count-1]);
    +        if sub.FSeeAlso<>'' then
    +          begin
    +            sub.FSeeAlso:=SeeAlso;
    +            exit;
    +          end;
    +      end;
    +   sub :=TChmSiteMapSubItem.create(self);
    +   FSubItems.add(sub);
    +   sub.FSeeAlso:=SeeAlso;
    +end;
    +
    +
    +procedure TChmSiteMapItem.AddURL(const URL: string);
    +var sub :TChmSiteMapSubItem;
    +begin
    +   if fsubitems.count>0 then
    +      begin
    +        sub:=TChmSiteMapSubItem(fsubitems[FSubItems.count-1]);
    +        if sub.FURL<>'' then
    +          begin
    +            sub.fURL:=URL;
    +            exit;
    +          end;
    +      end
    +   { else not possible according to chmspec. An URL must always follow a "local" item}
    +end;
    +
    +procedure TChmSiteMapItem.AddType(const AType: string);
    +// in Tocs, Type can be the first is the same as local
    +var sub :TChmSiteMapSubItem;
    +begin
    +   if fsubitems.count>0 then
    +      begin
    +        sub:=TChmSiteMapSubItem(fsubitems[FSubItems.count-1]);
    +        if sub.ItemType<>'' then
    +          begin
    +            sub.ItemType:=AType;
    +            exit;
    +          end;
    +      end;
    +   sub :=TChmSiteMapSubItem.create(self);
    +   FSubItems.add(sub);
    +   sub.ItemType:=AType;
    +end;
    +
    +procedure TChmSiteMapItem.Sort(Compare: TListSortCompare);
    +begin
    +  FChildren.sort(compare);
    +end;
    +
     { TChmSiteMapItems }
     
     function TChmSiteMapItems.GetItem(AIndex: Integer): TChmSiteMapItem;
    @@ -521,6 +768,15 @@
       Result := TChmSiteMapItem(FList.Items[AIndex]);
     end;
     
    +function TChmSiteMapItems.getparentname: String;
    +begin
    +  result:='Not assigned';
    +  if assigned(fparentitem) then
    +    begin
    +      result:=FParentItem.name;
    +    end;
    +end;
    +
     function TChmSiteMapItems.GetCount: Integer;
     begin
       Result := FList.Count;
    @@ -577,8 +833,11 @@
     end;
     
     procedure TChmSiteMapItems.Sort(Compare: TListSortCompare);
    +var I :Integer;
     begin
       FList.Sort(Compare);
    +  for i:=0 to flist.Count-1 do
    +    TChmSiteMapItem(flist[i]).sort(Compare)
     end;
     
     end.
    Index: packages/chm/src/chmwriter.pas
    ===================================================================
    --- packages/chm/src/chmwriter.pas	(revision 42090)
    +++ packages/chm/src/chmwriter.pas	(working copy)
    @@ -6,7 +6,7 @@
       option) any later version.
     
       This program is distributed in the hope that it will be useful, but WITHOUT
    -  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
    +    ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
       FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
       for more details.
     
    @@ -22,7 +22,7 @@
     {$MODE OBJFPC}{$H+}
     
     interface
    -uses Classes, ChmBase, chmtypes, chmspecialfiles, HtmlIndexer, chmsitemap, contnrs, StreamEx, Avl_Tree, lzxcompressthread;
    +uses Generics.Collections,Classes, ChmBase, chmtypes, chmspecialfiles, HtmlIndexer, chmsitemap, contnrs, StreamEx, Avl_Tree, lzxcompressthread;
     
     Const
        DefaultHHC = 'Default.hhc';
    @@ -154,6 +154,7 @@
         FAvlStrings   : TAVLTree;    // dedupe strings
         FAVLTopicdedupe : TAVlTree;  // Topic deduping, if we load it both from hhp and TOC
         FAvlURLStr    : TAVLTree;    // dedupe urltbl + binindex must resolve URL to topicid
    +    FDictTopicsUrlInd    : specialize TDictionary<string,integer>; // if url exists reuse topic.
         SpareString   : TStringIndex;
         SpareUrlStr   : TUrlStrIndex;
         FWindows      : TObjectList;
    @@ -164,6 +165,7 @@
         FTocSM        : TCHMSitemap;
         FHasKLinks    : Boolean;
         FNrTopics     : Integer;
    +
       protected
         procedure FileAdded(AStream: TStream; const AEntry: TFileEntryRec); override;
       private
    @@ -186,6 +188,7 @@
         function AddURL(AURL: String; TopicsIndex: DWord): LongWord;
         procedure CheckFileMakeSearchable(AStream: TStream; AFileEntry: TFileEntryRec);
         function AddTopic(ATitle,AnUrl:AnsiString;code:integer=-1):integer;
    +    function AddTopicindex(ATitle,AnUrl:AnsiString;code:integer=-1):integer;
         procedure ScanSitemap(asitemap:TCHMSiteMap);
         function NextTopicIndex: Integer;
         procedure Setwindows (AWindowList:TObjectList);
    @@ -1521,6 +1524,7 @@
       FDefaultWindow:= '';
       FMergeFiles   :=TStringList.Create;
       FNrTopics     :=0;
    +  FDictTopicsUrlInd    :=specialize TDictionary<string,integer>.Create;
     end;
     
     destructor TChmWriter.Destroy;
    @@ -1543,7 +1547,7 @@
       FAVLTopicdedupe.FreeAndClear;
       FAVLTopicdedupe.free;
       FWindows.Free;
    -
    +  FDictTopicsUrlInd.Free;
       inherited Destroy;
     end;
     
    @@ -1664,6 +1668,7 @@
         TopicEntry: TTopicEntry;
     
     begin
    +    ATitle :=StringReplace(Atitle, '&x27;', '', [rfReplaceAll]);
         anurl:=StringReplace(anurl, '\', '/', [rfReplaceAll]);
         if ATitle <> '' then
           TopicEntry.StringsOffset := AddString(ATitle)
    @@ -1691,8 +1696,35 @@
         FTopicsStream.WriteDWord(LEtoN(TopicEntry.URLTableOffset));
         FTopicsStream.WriteWord(LEtoN(TopicEntry.InContents));
         FTopicsStream.WriteWord(LEtoN(TopicEntry.Unknown));
    +    {$ifdef binindex}
    +    writeln('topout:',result, ' ' , TopicEntry.StringsOffset,' ' ,TopicEntry.URLTableOffset, ' ',atitle,' - ', anurl);
    +    {$endif}
     end;
     
    +function TChmWriter.AddTopicindex(ATitle, AnUrl: AnsiString; code: integer
    +  ): integer;
    +
    +begin
    +   ATitle :=StringReplace(Atitle, '&x27;', '', [rfReplaceAll]);
    +
    +  // adhoc subsitutions. Replace with real code if exact behaviour is known.
    +{  Atitle:=StringReplace(atitle, '&x27;', '''', [rfReplaceAll]);
    +  if length(atitle)>0 then
    +    atitle[1]:=uppercase(atitle[1])[1];}
    +  {$ifdef binindex}
    +  writeln('Enter ',ATitle,' ',AnUrl);
    +  {$endif}
    +  if FDictTopicsUrlInd.trygetvalue(anurl,result) then
    +   begin
    +     writeln('found:',result);
    +   end
    +   else
    +    begin
    +      result:=addtopic(atitle,anurl);
    +      FDictTopicsUrlInd.add(anurl,result);
    +    end;
    +end;
    +
     procedure TChmWriter.ScanSitemap(asitemap:TCHMSiteMap);
     procedure scanitems(it:TChmSiteMapItems);
     
    @@ -2039,32 +2071,60 @@
       inc(blockind,indexentrysize);
     end;
     
    -procedure CreateEntry(Item:TChmSiteMapItem;Str:WideString;commaatposition:integer);
    +procedure WritestrNT(var p:pbyte;const str:Unicodestring);
    +var i : integer;
    +    p2 : pbyte;
    +begin
    +  p2:=p;
    +  for i:=1 to Length(str) do
    +    WriteWord(p2,Word(str[i]));   // write the wstr in little endian
    +  WriteWord(p2,0);                // NT
    +  p:=p2;
    +end;
     
    +procedure CreateEntry(Item:TChmSiteMapItem;const Str:UnicodeString;commaatposition,level:integer);
    +
     var p      : pbyte;
         topicid: integer;
         seealso: Integer;
         entrysize:Integer;
         i      : Integer;
    +    sb :TChmSiteMapSubItem;
     begin
       inc(TotalEntries);
       fillchar(testblock[0],DefBlockSize,#0);
       p:=@TestBlock[0];
    -  for i:=1 to Length(str) do
    -    WriteWord(p,Word(str[i]));   // write the wstr in little endian
    -  WriteWord(p,0);                // NT
    -//  if item.seealso='' then    // no seealso for now
    -    seealso:=0;
    - // else
    -//    seealso:=2;
    +
    +  WritestrNT(p,Str);
    +  if item.seealso='' then    // no seealso for now
    +    seealso:=0
    +   else
    +    seealso:=2;
       WriteWord(p,seealso);          // =0 not a see also 2 =seealso
    -  WriteWord(p,0);                // Entrydepth.  We can't know it, so write 2.
    +  WriteWord(p,level);            // Entrydepth.  We can't know it, so write 2.
       WriteDword(p,commaatposition); // position of the comma
       WriteDword(p,0);               // unused 0
    -  WriteDword(p,1);               // for now only local pair.
    -  TopicId:=AddTopic(Item.Text,item.Local);
    -  WriteDword(p,TopicId);
    -  // if seealso then _here_ a wchar NT string with seealso?
    +
    +  if seealso=2 then
    +   begin
    +     write('!seealso');
    +     WriteDword(p,1);
    +     WritestrNT(p,item.seealso)
    +   end
    +  else
    +    begin
    +      WriteDword(p,item.SubItemcount);
    +      for i:=0 to item.SubItemcount-1 do
    +        begin
    +          sb:=item.SubItem[i];
    +          if sb.name='' then
    +            sb.name:=item.name;
    +          writeln('---',sb.name,' ',sb.local);
    +          TopicId:=AddTopicIndex(sb.Name,sb.Local);
    +          WriteDword(p,TopicId);
    +        end;
    +    end;
    +
       WriteDword(p,1);               // always 1 (unknown);
       WriteDword(p,mod13value);      //a value that increments with 13.
       mod13value:=mod13value+13;
    @@ -2158,32 +2218,36 @@
       Result:=blk-start;
     end;
     
    -procedure CombineWithChildren(ParentItem:TChmSiteMapItem;Str:WideString;commaatposition:integer;first:boolean);
    +procedure CombineWithChildren(ParentItem:TChmSiteMapItem;Str:UnicodeString;commaatposition:integer;level:integer);
     var i    : Integer;
    -    Item : TChmSiteMapItem;
    +    llItem : TChmSiteMapItem;
     begin
    -  if ParentItem.Children.Count = 0 Then
    -    Begin
    +   str:=StringReplace(str, '&x27;', '', [rfReplaceAll]);
    +   {$ifdef binindex}
    +     writeln('i:',level,' ',str);
    +   {$endif}
    +//  if ParentItem.Children.Count = 0 Then
    +//    Begin
          // comment/fix next
          //   if commatposition=length(str) then commaatposition:=0;
    -       if first then
    -        CreateEntry(ParentItem,Str,0)
    +       if level=0 then
    +        CreateEntry(ParentItem,Str,0,level)
            else
    -        CreateEntry(ParentItem,Str,commaatposition);
    -    End
    -  Else
    +        CreateEntry(ParentItem,Str,commaatposition,level);
    +//    End
    +//  Else
         for i:=0 to ParentItem.Children.Count-1 do
           begin
    -        item := TChmSiteMapItem(ParentItem.Children.Item[i]);
    -        if first Then
    -          CombineWithChildren(Item,Str+', '+item.text,commaatposition+2,false)
    -        else
    -          CombineWithChildren(Item,Str+', '+item.text,commaatposition,false);
    +        llitem := TChmSiteMapItem(ParentItem.Children.Item[i]);
    +{        if level=0 Then
    +          CombineWithChildren(Item,str+', '+item.text,0,level+1)
    +        else}
    +          CombineWithChildren(llItem,Str+', '+llitem.text,length(str)+2,level+1);
           end;
     end;
     
     Var i             : Integer;
    -    Key           : WideString;
    +    Key           : UnicodeString;
         Item          : TChmSiteMapItem;
         ListingBlocks : Integer;
         EntryBytes    : Integer;
    @@ -2204,6 +2268,7 @@
       {$ifdef binindex}
         writeln('starting index');
       {$endif}
    +  ASiteMap.sort(@indexitemcompare);
       IndexStream:=TMemoryStream.Create;
       indexstream.size:=sizeof(TBTreeHeader);
       IndexStream.position:=Sizeof(TBTreeHeader);
    @@ -2251,7 +2316,7 @@
           // so we can see if Windows loads the binary or textual index.
           CombineWithChildren(Item,Key+'2',length(key)+1,true);
           {$else}
    -      CombineWithChildren(Item,Key,length(key),true);
    +      CombineWithChildren(Item,Key,length(key),0);
           {$endif}
         end;
       PrepareCurrentBlock(True);     // flush last listing block.
    @@ -2420,7 +2485,6 @@
       PostAddStreamToArchive(AName, '/', AStream);
     end;
     
    -
     procedure TChmWriter.AddContext(AContext: DWord; ATopic: String);
     var
       Offset: DWord;
    @@ -2448,7 +2512,6 @@
     end;
     
     procedure TChmWriter.Setwindows(AWindowList: TObjectList);
    -
     var i : integer;
         x : TCHMWindow;
     begin
    Index: utils/fpdoc/dw_htmlchm.inc
    ===================================================================
    --- utils/fpdoc/dw_htmlchm.inc	(revision 42090)
    +++ utils/fpdoc/dw_htmlchm.inc	(working copy)
    @@ -192,12 +192,12 @@
             // by unit
             TmpItem := ObjUnitItem.Children.NewItem;
             TmpItem.Text := Element.Name;
    -        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(Element, 0));
    +        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(Element, 0)));
             
             //alpha
             TmpItem := GetAlphaItem(AlphaObjItem.Children, UpperCase(Copy(Element.Name, 1, 2))).Children.NewItem;
             TmpItem.Text := Element.Name;
    -        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(Element, 0));
    +        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(Element, 0)));
             
           end;
           
    @@ -208,12 +208,12 @@
             // by unit
             TmpItem := RoutinesUnitItem.Children.NewItem;
             TmpItem.Text := Element.Name;
    -        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(Element, 0));
    +        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(Element, 0)));
             
             // alpha
             TmpItem := GetAlphaItem(AlphaRoutinesItem.Children, UpperCase(Element.Name[1])).Children.NewItem;
             TmpItem.Text := Element.Name;
    -        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(Element, 0));
    +        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(Element, 0)));
           end;
         end;
       end;
    @@ -305,7 +305,7 @@
             continue;
           ParentItem := Index.Items.NewItem;
           ParentItem.Text := AModule.Name;
    -      ParentItem.Local := FixHTMLpath(Allocator.GetFilename(AModule, 0));
    +      ParentItem.addLocal(FixHTMLpath(Allocator.GetFilename(AModule, 0)));
     
           //  classes
           for j := 0 to AModule.InterfaceSection.Classes.Count-1 do
    @@ -313,7 +313,7 @@
             ParentElement := TPasClassType(AModule.InterfaceSection.Classes[j]);
             ParentItem := Index.Items.NewItem;
             ParentItem.Text := ParentELement.Name;
    -        ParentItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
    +        ParentItem.addLocal(FixHTMLpath(Allocator.GetFilename(ParentElement, 0)));
             for k := 0 to TPasClassType(ParentElement).Members.Count-1 do
             begin
               TmpElement := TPasElement(TPasClassType(ParentElement).Members.Items[k]);
    @@ -336,11 +336,11 @@
                 cmtInterface   : TmpItem.Text := TmpElement.Name + ' interface';
                 cmtUnknown     : TmpItem.Text := TmpElement.Name;
               end;
    -          TmpItem.Local := FixHTMLpath(Allocator.GetFilename(TmpElement, 0));
    +          TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(TmpElement, 0)));
               if (trim(s)<>'') and (tmpitem.local<>s) then
                 begin
                   writeln('Hint: Index: Resolved:',tmpitem.local,' to ',s);
    -              tmpitem.local:=s;
    +              tmpitem.addLocal(s);
                 end;
     
               {
    @@ -350,11 +350,11 @@
               MemberItem := nil;
               MemberItem := GetAlphaItem(Index.Items, TmpElement.Name);
               // ahh! if MemberItem.Local is empty MemberType is not shown!
    -          MemberItem.Local := FixHTMLpath(Allocator.GetFilename(TmpElement, 0));
    +          MemberItem.addLocal(FixHTMLpath(Allocator.GetFilename(TmpElement, 0)));
     
               TmpItem := MemberItem.Children.NewItem;
               TmpItem.Text := ParentElement.Name;
    -          TmpITem.Local := FixHTMLpath(Allocator.GetFilename(TmpElement, 0));
    +          TmpITem.addLocal(FixHTMLpath(Allocator.GetFilename(TmpElement, 0)));
             end;
           end;
           // routines
    @@ -363,7 +363,7 @@
             ParentElement := TPasProcedureType(AModule.InterfaceSection.Functions[j]);
             TmpItem := Index.Items.NewItem;
             TmpItem.Text := ParentElement.Name + ' ' + ParentElement.ElementTypeName;
    -        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
    +        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(ParentElement, 0)));
           end;
           // consts
           for j := 0 to AModule.InterfaceSection.Consts.Count-1 do
    @@ -371,7 +371,7 @@
             ParentElement := TPasElement(AModule.InterfaceSection.Consts[j]);
             TmpItem := Index.Items.NewItem;
             TmpItem.Text := ParentElement.Name;
    -        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
    +        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(ParentElement, 0)));
           end;
           // types
           for j := 0 to AModule.InterfaceSection.Types.Count-1 do
    @@ -379,7 +379,7 @@
             ParentElement := TPasType(AModule.InterfaceSection.Types[j]);
             TmpItem := Index.Items.NewItem;
             TmpItem.Text := ParentElement.Name;
    -        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
    +        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(ParentElement, 0)));
             // enums
             if ParentELement is TPasEnumType then
             begin
    @@ -390,11 +390,11 @@
                 // subitem
                 TmpItem := ParentItem.Children.NewItem;
                 TmpItem.Text := TmpElement.Name;
    -            TmpItem.Local := ParentItem.Local;
    +            TmpItem.addLocal(ParentItem.Local);
                 // root level
                 TmpItem := Index.Items.NewItem;
                 TmpItem.Text := TmpElement.Name;
    -            TmpItem.Local := ParentItem.Local;
    +            TmpItem.addLocal(ParentItem.Local);
               end;
             end;
           end;
    @@ -404,7 +404,7 @@
             ParentElement := TPasElement(AModule.InterfaceSection.Variables[j]);
             TmpItem := Index.Items.NewItem;
             TmpItem.Text := ParentElement.Name + ' var';
    -        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
    +        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(ParentElement, 0)));
           end;
           // declarations
           {
    
    chmworking.patch (57,390 bytes)

Activities

wp

2018-08-31 13:04

reporter   ~0110404

Last edited: 2018-08-31 13:06

View 4 revisions

I cannot confirm. The attached chm project does contain the index. It was created this way (on Windows):

- Unzip the files of the chm project to some folder.
- Compile chmcmd and copy the binary to this folder.
- Execute
              chmcmd moon.hhp
- chmcmd will generate some warnings due to missing .js files, but this does not affect the functionality of the generated chm file.
- The Microsoft chm viewer opens and displays this chm file correctly.

eri0o

2018-08-31 15:42

reporter   ~0110408

I am sorry, I think I reported wrong. The file does have an index, but it appears to be missing Keyword Links.

Our .hhp project can be downloaded here

https://github.com/adventuregamestudio/ags-manual/releases/tag/0.1.7

Some more details here:

https://github.com/adventuregamestudio/ags-manual/issues/14#issuecomment-417660672

When using HTML Help Workshop we get a folder inside the chm called $WWKeywordLinks but this folder is not present when using chmcmd, making difficulty to use it's generated .chm integrated with the software.

wp

2018-08-31 16:43

reporter   ~0110411

Please ignore my ignorance: How can I see that keyword links are missing? what do I have to do to see the error? Please give step-by-step instructions.

I compiled the chm file from your sources by chmcmd of fpc trunk and of fpc 3.0.4 (there were some recent changes) as well as by MS Help Workshop. All the chm files created look very similar, even in size (+/- 30 kB).

chmcmd reports a long list of anchors not being defined. Are you sure that the source html files are correct?

Sven Barth

2018-08-31 17:59

manager   ~0110415

You need to set the "Binary Index" option in the project to "Yes" (maybe also "Binary TOC"), then the $WWKeywordsLinks folder is created. Don't know why that isn't an issue with the Microsoft tool, but chmcmd respects those options.

wp

2018-08-31 19:16

reporter   ~0110418

Isn't the binary index just a binary version of the same index data which are in the file anyway?

@eriOo: What exactly is the problem? When you press F1 (i.e., call for help) then the help window does not show? How can you be sure that the bug is in chmcmd and not in your application?

I was able to use the chmcmd-created help file of your application in the demo of the Lazarus chm help system,(lazarus)/components/chmhelp/democontrol/ContextHelpDemo.lpi). Therefore I tend to believe that the chm files were created correctly with chmcmd.

eri0o

2018-08-31 19:33

reporter   ~0110421

Ok, it appears I made a confusion with the .hhp files and am wrong. I am sorry for the trouble. I will test the options on the xml file and confirm here which option worked for the KeywordLinks generation. This chmcmd tool is awesome and allow cross-platform chm help generation. I am really grateful for this project.

Marco van de Voort

2018-08-31 21:20

manager   ~0110424

Note there is something like real keyword links (not just the name in the file list), but IIRC those look like activex objects (objects with a guid) in the source, and they are rare.

Sven Barth

2018-08-31 21:21

manager   ~0110425

@wp: if you uncompress the chm file with unzip or whatever you'll see the $WWKeywordLinks directory if "Binary Index" is enabled; otherwise this directory will be missing. In case of the Microsoft Help Tool Builder this might be generated nevertheless or something else is different...

@eri0o: yes, please report back if you managed to fix/verify this on your side, so that we can resolve this.

Marco van de Voort

2018-08-31 21:52

manager   ~0110427

Last edited: 2018-08-31 21:52

View 2 revisions

Btw afaik generally binary index is recommended ON, and binary TOC off. Those are mshelp defaults.

eri0o

2018-09-01 04:57

reporter   ~0110432

Last edited: 2018-09-01 05:00

View 2 revisions

Here we have the build results for both the chm files generated by chmcmd and HTMLHelpWorkshop - I booted a Windows machine just to run the HTML Help Workshop hhc.exe.

(note, the .hhp project zipped here is saved before we swap the No to Yes on the appropriate fields using our script make-chm-from-htmlhelp.sh)

https://github.com/adventuregamestudio/ags-manual/releases/tag/0.1.8

Ok, so the result is that marking binary TOC Yes and Binary index Yes I get both folders I wanted: $WWAssociativeLinks and $WWKeywordLinks .

But the resulting BTree from chmcmd is comming nearly empty - you need an Hex Editor to verify that. If you look the BTree on the file generated from HTML Help Workshop it will be correctly filled.

So there is something different.

Now the bad news for me. It didn't matter. Even having everything generated through HTML Help Workshop from the project generated through sphinx, the resulting chm didn't work for my goal - using Help.ShowHelp KeywordIndex on .NET.

So I think there is indeed a bug on chmcmd, correclty generating BTree under $WWKeywordLinks, but it is not what is affecting me.

our script for making the chm https://github.com/adventuregamestudio/ags-manual/blob/master/make-chm-from-htmlhelp.sh

Marco van de Voort

2018-09-01 13:16

manager   ~0110436

I will investigate, but it will take some time.

Jeppe Johansen

2018-09-01 14:01

developer   ~0110438

So, I'm not entirely sure what the problem is in this case, but I had previously run into a problem with full text search in the CHM writer. Basically that it didn't include words that only occurred once.

If it is related can you try the patch I've attached?

Jeppe Johansen

2018-09-01 14:01

developer  

chm_fixes.patch (3,594 bytes)
Index: packages/chm/src/chmfilewriter.pas
===================================================================
--- packages/chm/src/chmfilewriter.pas	(revision 39308)
+++ packages/chm/src/chmfilewriter.pas	(working copy)
@@ -933,6 +933,8 @@
                        Error(ChmWarning,'Found file '+s+' while scanning '+fn+', but couldn''t find it on disk',2);
                  end;
              except
+               on e:EDomError do
+                  Error(ChmError,'Html parsing '+fn+', failed with a DOM error: '+e.Message);
                on e:exception do
                   Error(ChmError,'Html parsing '+fn+', failed. Please submit a bug.');
                end;
@@ -943,6 +945,29 @@
              Error(chmnote,'Can''t find file '+fn+' to scan it.',5);
            end;
         end
+     else if FileExists(fn) and (uppercase(ExtractFileExt(fn))='.CSS') then
+       begin
+         tmplst:=TStringList.Create;
+         try
+           tmplst.LoadFromFile(fn);
+
+           for i:=0 to tmplst.Count-1 do
+             begin
+               s:=tmplst[i];
+               if pos('url(''', tmplst[i])>0 then
+                 begin
+                   delete(s,1,pos('url(''', tmplst[i])+4);
+                   s:=trim(copy(s,1,pos('''',s)-1));
+
+                   if not trypath(s) then
+//                     if not trypath(localpath+s) then
+                       Error(ChmWarning,'Found file '+s+' while scanning '+fn+', but couldn''t find it on disk',2);
+                 end;
+             end;
+         finally
+           tmplst.Free;
+         end;
+       end
      else
        Error(chmnote,'Not scanning file because of unknown extension '+fn,5);
    end;
Index: packages/chm/src/chmsitemap.pas
===================================================================
--- packages/chm/src/chmsitemap.pas	(revision 39308)
+++ packages/chm/src/chmsitemap.pas	(working copy)
@@ -169,8 +169,15 @@
 end;
 
 procedure TChmSiteMap.FoundTag(ACaseInsensitiveTag, AActualTag: string);
+    procedure NewSiteMapItem;
+    begin
+      FCurrentItems.Add(TChmSiteMapItem.Create(FCurrentItems));
+    end;
     function ActiveItem: TChmSiteMapItem;
     begin
+      if FCurrentItems.Count=0 then
+        NewSiteMapItem;
+
       Result := FCurrentItems.Item[FCurrentItems.Count-1]
     end;
     procedure IncreaseULevel;
@@ -189,10 +196,6 @@
       else FCurrentItems := nil;
       Dec(FLevel);
     end;
-    procedure NewSiteMapItem;
-    begin
-      FCurrentItems.Add(TChmSiteMapItem.Create(FCurrentItems));
-    end;
 var
   TagName,
   //TagAttribute,
Index: packages/chm/src/htmlindexer.pas
===================================================================
--- packages/chm/src/htmlindexer.pas	(revision 39308)
+++ packages/chm/src/htmlindexer.pas	(working copy)
@@ -216,6 +216,10 @@
 begin
   if Length(Text) < 1 then
     Exit;
+
+  if (not FInTitle) and (not FInBody) then
+    Exit;
+
   EatWords(Text, FInTitle and not FInBody);
 end;
 
@@ -278,7 +282,7 @@
     WordName := Copy(WordStart, 0, (WordPtr-WordStart));
     try
     WordIndex := addgetword(wordname,istitle); // Self.Words[WordName, IsTitle];
-    except on e:exception do writeln(wordname); end;
+    except on e:exception do writeln('Error: ', wordname); end;
     WordIndex.DocumentTopic[FTopicIndex].AddWordIndex(FWordCount);
     InWord := False;
     //if IsNumberWord then WriteLn('Following is NUMBER WORD: "', (WordStart[0]),'"'); ;
@@ -497,7 +501,7 @@
 
 function TIndexDocument.getindexentries:integer;
 begin
- result:=flastentry-1; 
+ result:=flastentry;
 end;
 
 end.
chm_fixes.patch (3,594 bytes)

eri0o

2018-09-01 17:07

reporter   ~0110448

Can you point me a link on how to build chmcmd from source?

Jeppe Johansen

2018-09-01 17:37

developer   ~0110449

It's a fairly contained project, so you can just get the FPC sources, apply the patch, and then copy all files from the "packages/chm/src/" to a separate directory and then compile chmcmd.lpr in that directory.

Marco van de Voort

2018-09-01 20:34

manager   ~0110453

There are also fulltext fixes in trunk

Marco van de Voort

2018-09-01 21:24

manager  

hhex2.pp (1,147 bytes)
Program hhex2;
{$mode delphi}
{
   Small example/test of the html help OCX.
   Marco van de Voort (C) 2009

   Copy rtl.chm from the CHM distribution to this dir. Test keyword/alink search.
}

Uses HTMLHelp;

var
   keyword      : ansistring; 
   HelpfileName : AnsiString;
   htmltopic    : AnsiString;
   res 		: Integer;
   ah           : PHH_AKLINK ;
   
Begin
  Helpfilename:='AGSHelpdoc.chm';
  keyword:='Setting up the game' ;
 
  New(ah);
  fillchar(ah^,sizeof(ah^),#0); 
  ah.cbstruct:=sizeof(tagHH_AKLINK);
  ah.fReserved   := FALSE ;
  ah.pszKeywords :=pansichar(keyword);  
  ah.pszUrl      := NIL ;
  ah.pszMsgText  :='Text succes' ;
  ah.pszMsgTitle :='Text fail';
  ah.pszWindow   := NIL ;
  ah.fIndexOnFail:= false;

 
  Res:=HtmlHelpA(0,pchar(helpfilename) ,HH_DISPLAY_INDEX,PTRUINT(PAnsiChar(Keyword)));	

  // keyword search seems to have same effect.
  Res:=HtmlHelpA(0,pchar(helpfilename) ,HH_ALINK_LOOKUP,PTRUINT(AH));	
  writeln(ah.pszkeywords);
  writeln(ah.pszurl);
  writeln(ah.pszmsgtext);
  writeln(ah.pszmsgtitle);
  writeln(ah.pszwindow);
  writeln(res);

 readln;
end.
hhex2.pp (1,147 bytes)

Marco van de Voort

2018-09-01 21:37

manager  

hhex3.pp (1,109 bytes)
Program hhex2;
{$mode delphi}
{
   Small example/test of the html help OCX.
   Marco van de Voort (C) 2009

   Copy rtl.chm from the CHM distribution to this dir. Test keyword/alink search.
}

Uses HTMLHelp;

var
   keyword      : ansistring; 
   HelpfileName : AnsiString;
   htmltopic    : AnsiString;
   res 		: Integer;
   ah           : PHH_AKLINK ;
   
Begin
  Helpfilename:='AGSHelpdoc.chm';
  keyword:='Arrays' ;
 
  New(ah);
  fillchar(ah^,sizeof(ah^),#0); 
  ah.cbstruct:=sizeof(tagHH_AKLINK);
  ah.fReserved   := FALSE ;
  ah.pszKeywords :=pansichar(keyword);  
  ah.pszUrl      := NIL ;
  ah.pszMsgText  :='Text succes' ;
  ah.pszMsgTitle :='Text fail';
  ah.pszWindow   := NIL ;
  ah.fIndexOnFail:= true;

 
  Res:=HtmlHelpA(0,pchar(helpfilename) ,HH_DISPLAY_TOPIC,0);	

  // keyword search seems to have same effect.
  Res:=HtmlHelpA(0,pchar(helpfilename) ,HH_KEYWORD_LOOKUP,PTRUINT(AH));	
  writeln(ah.pszkeywords);
  writeln(ah.pszurl);
  writeln(ah.pszmsgtext);
  writeln(ah.pszmsgtitle);
  writeln(ah.pszwindow);
  writeln(res);

 readln;
end.
hhex3.pp (1,109 bytes)

Jeppe Johansen

2018-09-01 21:51

developer   ~0110454

Sorry Marco. Didn't see that you had applied it already. Thanks :)

Marco van de Voort

2018-09-02 13:39

manager   ~0110459

I tested a bit yesterday, and the attached hhex3 does look up files for the workshop version, and not for the chmcmd version. And indeed the trees look empty.

Marco van de Voort

2018-09-02 16:06

manager   ~0110460

Last edited: 2018-09-02 16:08

View 2 revisions

Ok, the reason why that happens is because the html parser expects <BODY> tags in the hhk! If you add those the index gets larger.

workshop index:
 1 4729570 245836 /$WWKeywordLinks/BTree
 1 4975406 28535 /$WWKeywordLinks/Data
 1 5003941 906 /$WWKeywordLinks/Map
 1 5004847 32 /$WWKeywordLinks/Property

chmcmd index:

 1 4387466 192588 /$WWKeywordLinks/BTree
 1 4580054 20124 /$WWKeywordLinks/Data
 1 4600178 706 /$WWKeywordLinks/Map
 1 4600884 1 /$WWKeywordLinks/Property

so roughly at least 4/5 of the workshop size.

I also have a hunch about the reason of those 1/5th. Possibly workshop makes simply more nodes and chmcmd should follow. This probably never was noticed because our tests files used less nested entries in the index.

eri0o

2018-09-05 04:30

reporter   ~0110509

Just a note that on our repository we are triggering simultaneous builds on HTML Help Workshop and chmcmd on each commit. I still don't know the proper place to get chmcmd prebuilt binaries for Ubuntu for the latest version. This may or may not be useful for comparison of builds.

eri0o

2018-10-25 14:50

reporter   ~0111554

Hey, if someone knows how to get latest chmcmd binaries for Ubuntu it would be great for us to have more significant comparison between Travis build with chmcmd and html help workshop on Windows (appveyor).

Anton Kavalenka

2018-10-25 20:26

reporter   ~0111556

https://packages.debian.org/search?keywords=lazarus&searchon=names&suite=experimental&section=all

Marco van de Voort

2019-05-19 10:08

manager   ~0116257

Last edited: 2019-05-19 10:10

View 2 revisions

I had a breakthrough yesterday, and as such have made quite some progress. I need to clean the patches of debug output, test our own documentation tool and there are still a few issues with index generation when testing with the AGS snapshot.

- I have some topics with &x27; in it that the htmlhelp version doesn't.
- A very few one letter (X and Y) links get uppercased. Possibly because X and Y happen both as toplevel and second level name ? Having one map to disambiguate is probably not enough.
- some topics move place in the tree. I don't yet know why. (also corner case, it's like 2 topics)

chmcmd binaries are fully static. IOW I can create one (assume linux/x86_64) and it should work fine on most distributions. Since this patch is already an huge improvement, it will get merged back to FPC 3.2 fixes branch and will be available in FPC3.2.0 in time

A new complete AGS help project snapshot (as it is passed to the HHC compiler) would be welcome.



chmworking.patch (57,390 bytes)
Index: packages/chm/fpmake.pp
===================================================================
--- packages/chm/fpmake.pp	(revision 42090)
+++ packages/chm/fpmake.pp	(working copy)
@@ -31,6 +31,7 @@
 
     D:=P.Dependencies.Add('fcl-xml');
     D:=P.Dependencies.Add('fcl-base');
+    D:=P.Dependencies.Add('rtl-generics');
     D.Version:='3.3.1';
 
     P.SourcePath.Add('src');
Index: packages/chm/src/chmcmd.lpr
===================================================================
--- packages/chm/src/chmcmd.lpr	(revision 42090)
+++ packages/chm/src/chmcmd.lpr	(working copy)
@@ -145,7 +145,7 @@
   else
     begin
      try
-      project.ScanHtmlContents:=htmlscan=scanforce;  // .hhp default SCAN
+      project.ScanHtmlContents:=htmlscan in [scanforce, scandefault];  // .hhp default SCAN
       Project.LoadFromFile(name);
      except
        on e:exception do
@@ -166,7 +166,6 @@
     end;
   OutStream.Free;
   Project.Free;
-
 end;
 
 var
Index: packages/chm/src/chmfilewriter.pas
===================================================================
--- packages/chm/src/chmfilewriter.pas	(revision 42090)
+++ packages/chm/src/chmfilewriter.pas	(working copy)
@@ -926,7 +926,7 @@
                scantags(domdoc,extractfilename(fn),localfilelist);
                for i:=0 to localFilelist.count-1 do
                  begin
-                   s:=localfilelist[i];
+                   s:=localfilelist[i];                   
                    if not trypath(s) then
 //                     if not trypath(localpath+s) then
                        Error(ChmWarning,'Found file '+s+' while scanning '+fn+', but couldn''t find it on disk',2);
@@ -984,8 +984,9 @@
 
 procedure scanitems(it:TChmSiteMapItems);
 
-var i : integer;
+var i,j : integer;
     x : TChmSiteMapItem;
+    si  : TChmSiteMapSubItem;
     s : string;
     strrec : TStringIndex;
 
@@ -993,7 +994,10 @@
   for i:=0 to it.count -1 do
     begin
       x:=it.item[i];
-      if sanitizeurl(fbasepath,x.local,'','Site Map for '+x.Text,S) then   // sanitize, remove stuff etc.
+      for j:=0 to x.SubItemcount-1 do
+         begin
+           si:=x.SubItem[j];
+      if sanitizeurl(fbasepath,si.local,'','Site Map for '+x.Text,S) then   // sanitize, remove stuff etc.
         begin
           if not FileInTotalList(uppercase(s)) then
             begin
@@ -1014,7 +1018,7 @@
         end
       else
        Error(chmnote,'Bad url: '+s+'.',5);
-
+         end;
       if assigned(x.children) and (x.children.count>0) then
         scanitems(x.children);
     end;
@@ -1213,6 +1217,7 @@
           FIndex:=TChmSiteMap.Create(stindex);
           FIndex.loadfromfile(FIndexFileName);
           Error(chmnote,'Index items:'+inttostr(findex.Items.count));
+          findex.SaveToFile('dummy.hhk');
         except
           on e: Exception do
             begin
Index: packages/chm/src/chmreader.pas
===================================================================
--- packages/chm/src/chmreader.pas	(revision 42090)
+++ packages/chm/src/chmreader.pas	(working copy)
@@ -20,15 +20,17 @@
 }
 unit chmreader;
 
-{$mode objfpc}{$H+}
+{$mode delphi}
 
 //{$DEFINE CHM_DEBUG}
 { $DEFINE CHM_DEBUG_CHUNKS}
-
+{$define binindex}
+{$define nonumber}
 interface
 
 uses
-  Classes, SysUtils, Contnrs, chmbase, paslzx, chmFIftiMain, chmsitemap;
+  Generics.Collections, Classes, SysUtils,  Contnrs,
+  chmbase, paslzx, chmFIftiMain, chmsitemap;
 
 type
 
@@ -729,7 +731,7 @@
   PMGIndex: Integer;
   {$ENDIF}
 begin
-  if ForEach = nil then Exit;
+  if not assigned(ForEach) then Exit;
   ChunkStream := TMemoryStream.Create;
   {$IFDEF CHM_DEBUG_CHUNKS}
   WriteLn('ChunkCount = ',fDirectoryHeader.DirectoryChunkCount);
@@ -970,6 +972,10 @@
     fTOPICSStream.ReadDWord;
     TopicTitleOffset := LEtoN(fTOPICSStream.ReadDWord);
     TopicURLTBLOffset := LEtoN(fTOPICSStream.ReadDWord);
+    {$ifndef nonumber}
+    writeln('titleid:',TopicTitleOffset);
+    writeln('urlid  :',TopicURLTBLOffset);
+    {$endif}
     if TopicTitleOffset <> $FFFFFFFF then
       ATitle := ReadStringsEntry(TopicTitleOffset);
      //WriteLn('Got a title: ', ATitle);
@@ -1016,7 +1022,10 @@
   result:=head<tail;
 
   n:=head-oldhead;
-  if (n>0) and (oldhead[n-1]=0) then dec(n); // remove trailing #0
+
+  pw:=pword(@oldhead[n]);
+  if (n>1) and (pw[-1]=0) then dec(n,2); // remove trailing #0
+//  writeln(n);
   setlength(ws,n div sizeof(widechar));
   move(oldhead^,ws[1],n);
   for n:=1 to length(ws) do
@@ -1024,11 +1033,16 @@
   readv:=ws; // force conversion for now, and hope it doesn't require cwstring
 end;
 
+
+Type TLookupRec = record
+                   item : TChmSiteMapItems;
+                   depth : integer;
+                   end;
+     TLookupDict = TDictionary<string,TLookupRec>;
 function TChmReader.GetIndexSitemap(ForceXML:boolean=false): TChmSiteMap;
 var Index   : TMemoryStream;
-    sitemap : TChmSiteMap;
-    Item    : TChmSiteMapItem;
 
+
 function  AbortAndTryTextual:tchmsitemap;
 
 begin
@@ -1045,7 +1059,7 @@
       result:=nil;
 end;
 
-procedure createentry(Name:ansistring;CharIndex:integer;Topic,Title:ansistring);
+{function createentry(Name:ansistring;CharIndex:integer;Topic,Title:ansistring):TChmSiteMapItem;
 var litem : TChmSiteMapItem;
     shortname : ansistring;
     longpart  : ansistring;
@@ -1053,6 +1067,7 @@
  if charindex=0 then
    begin
      item:=sitemap.items.NewItem;
+     item.addname(name);
      item.keyword:=Name;
      item.local:=topic;
      item.text:=title;
@@ -1065,7 +1080,7 @@
        begin
          litem:=item.children.newitem;
          litem.local:=topic;
-         litem.keyword :=longpart; // recursively split this? No examples.
+         litem.keyword :=longpart; // recursively split this? No examples. ->akelpad.chm
          litem.text:=title;
        end
       else
@@ -1089,32 +1104,49 @@
      item.KeyWord:=name;
      item.SeeAlso:=seealso;
 end;
+}
+var
+   parentitem:TChmSiteMapItems;
+   itemstack :TObjectList;
+   lookup  : TLookupDict;
+   curitemdepth : integer;
+   sitemap : TChmSiteMap;
 
+function getitem(anentrydepth:integer):Tchmsitemapitems;
+begin
+   if anentrydepth<itemstack.count then
+     result:=tchmsitemapitems(itemstack[anentrydepth])
+   else
+     begin
+       {$ifdef binindex}
+         writeln('pop from emptystack at ',anentrydepth,' ',itemstack.count);
+       {$endif}
+       result:=tchmsitemapitems(itemstack[itemstack.Count-1]);
+     end;
+end;
 
+procedure pushitem(anentrydepth:integer;anitem:tchmsitemapitem);
+begin
+
+ if anentrydepth<itemstack.count then
+   itemstack[anentrydepth]:=anitem.children
+ else
+   if anentrydepth=itemstack.count then
+     itemstack.add(anitem.Children)
+   else
+     begin
+       {$ifdef binindex}
+         writeln('push more than 1 larger ' ,anentrydepth,' ',itemstack.count);
+       {$endif}
+       itemstack.add(anitem.Children)
+     end;
+end;
 procedure parselistingblock(p:pbyte);
 var
-    itemstack:TObjectStack;
-    curitemdepth : integer;
-    parentitem:TChmSiteMap;
 
-procedure updateparentitem(entrydepth:integer);
-begin
-  if entrydepth>curitemdepth then
-    begin
-      if curitemdepth<>0 then
-        itemstack.push(parentitem);
-      curitemdepth:=entrydepth;
-    end
-  else
-   if entrydepth>curitemdepth then
-    begin
-      if curitemdepth<>0 then
-        itemstack.push(parentitem);
-      curitemdepth:=entrydepth;
-    end
-end;
+    Item    : TChmSiteMapItem;
 
-var hdr:PBTreeBlockHeader;
+    hdr:PBTreeBlockHeader;
     head,tail : pbyte;
     isseealso,
     entrydepth,
@@ -1125,9 +1157,42 @@
     CharIndex,
     ind:integer;
     seealsostr,
-    topic,
+    s,
     Name : AnsiString;
+    path,
+    shortname : AnsiString;
+    anitem:TChmSiteMapItems;
+    litem : TChmSiteMapItem;
+    lookupitem : TLookupRec;
+
+function readvalue:string;
 begin
+  if head<tail Then
+    begin
+      ind:=LEToN(plongint(head)^);
+
+      result:=lookuptopicbyid(ind,title);
+      {$ifdef binindex}
+        writeln(i:3,' topic: ' {$ifndef nonumber},'  (',ind,')' {$endif});
+        writeln('    title: ',title);
+        writeln('    result: ',result);
+      {$endif}
+      inc(head,4);
+    end;
+end;
+
+procedure dumpstack;
+var fp : TChmSiteMapItems;
+     ix : Integer;
+begin
+  for ix:=0 to itemstack.Count-1 do
+    begin
+      fp :=TChmSiteMapItems(itemstack[ix]);
+      writeln(ix:3,' ',fp.parentname);
+    end;
+end;
+
+begin
   //setlength (curitem,10);
   hdr:=PBTreeBlockHeader(p);
   hdr^.Length          :=LEToN(hdr^.Length);
@@ -1135,17 +1200,19 @@
   hdr^.IndexOfPrevBlock:=LEToN(hdr^.IndexOfPrevBlock);
   hdr^.IndexOfNextBlock:=LEToN(hdr^.IndexOfNextBlock);
 
+  writeln('hdr:',hdr^.length);
   tail:=p+(2048-hdr^.length);
   head:=p+sizeof(TBtreeBlockHeader);
 
-  itemstack:=TObjectStack.create;
   {$ifdef binindex}
+  {$ifndef nonumber}
   writeln('previndex  : ',hdr^.IndexOfPrevBlock);
   writeln('nextindex  : ',hdr^.IndexOfNextBlock);
   {$endif}
-  curitemdepth:=0;
+  {$endif}
   while head<tail do
     begin
+      //writeln(tail-head);
       if not ReadWCharString(Head,Tail,Name) Then
         Break;
       {$ifdef binindex}
@@ -1158,6 +1225,69 @@
       IsSeealso:=LEToN(PE^.isseealso);
       EntryDepth:=LEToN(PE^.entrydepth);
       CharIndex:=LEToN(PE^.CharIndex);
+      Path:='';
+
+      if charindex<>0 then
+        begin
+          Path:=Trim(Copy(Name,1,charindex-2));
+          Shortname:=trim(copy(Name,charindex,Length(Name)-Charindex+1));
+        end
+      else
+        shortname:=name;
+      writeln('depth:', curitemdepth, ' ' ,entrydepth);
+      if curitemdepth=entrydepth then // same level, so of same parent
+         begin
+           item:=parentitem.newitem;
+           pushitem(entrydepth+1,item);
+         end
+      else
+        if curitemdepth=entrydepth-1 then // new child, one lower.
+          begin
+            parentitem:=getitem(entrydepth);
+            item:=parentitem.newitem;
+            pushitem(entrydepth+1,item);
+          end
+        else
+         if entrydepth<curitemdepth then
+          begin
+            parentitem:=getitem(entrydepth);
+            writeln('bingo!', parentitem.parentname);
+            dumpstack;
+            item:=parentitem.newitem;
+            pushitem(entrydepth+1,item);
+          end;
+
+      curitemdepth:=entrydepth;
+      writeln('lookup:', Name, ' = ', path,' = ',shortname);
+
+    (*  if lookup.trygetvalue(path,lookupitem) then
+        begin
+//          if lookupitem.item<>parentitem then
+//             writeln('mismatch: ',lookupitem.item.item[0].name,' ',name);
+{          if curitemdepth<entrydepth then
+            begin
+              writeln('lookup ok!',curitemdepth,' ' ,entrydepth);
+              curitemdepth:=entrydepth;
+            end
+          else
+           begin
+             writeln('lookup odd!',curitemdepth,' ' ,entrydepth);
+           end;
+          curitemdepth:=lookupitem.depth+1;
+          parentitem:=lookupitem.item;}
+        end
+      else
+        begin
+ //            parentitem:=sitemap.Items;
+          if not curitemdepth=entrydepth then
+             writeln('no lookup odd!',curitemdepth,' ' ,entrydepth);
+        end;  *)
+{      item:=parentitem.newitem;}
+      lookupitem.item:=item.children;
+      lookupitem.depth:=entrydepth;
+      lookup.addorsetvalue(name,lookupitem);
+      item.AddName(Shortname);
+
       {$ifdef binindex}
         Writeln('seealso   :  ',IsSeeAlso);
         Writeln('entrydepth:  ',EntryDepth);
@@ -1178,7 +1308,7 @@
           {$ifdef binindex}
             writeln('seealso: ',seealsostr);
           {$endif}
-
+          item.AddSeeAlso(seealsostr);
         end
       else
         begin
@@ -1190,24 +1320,13 @@
 
             for i:=0 to nrpairs-1 do
               begin
-                if head<tail Then
-                  begin
-                    ind:=LEToN(plongint(head)^);
-                    topic:=lookuptopicbyid(ind,title);
-                    {$ifdef binindex}
-                      writeln(i:3,' topic: ',topic);
-                      writeln('    title: ',title);
-                    {$endif}
-                    inc(head,4);
-                  end;
+               s:=readvalue;
+             //  if not ((i=0) and (title=shortname)) then
+               item.addname(title);
+               item.addlocal(s);
               end;
           end;
          end;
-      if isseealso>0 then
-         createentryseealso(name,charindex,seealsostr)
-      else
-        if nrpairs<>0 Then
-          createentry(Name,CharIndex,Topic,Title);
       inc(head,4); // always 1
       {$ifdef binindex}
         if head<tail then
@@ -1215,7 +1334,6 @@
       {$endif}
       inc(head,4); // zero based index (13 higher than last
     end;
-  ItemStack.Free;
 end;
 
 var TryTextual : boolean;
@@ -1222,8 +1340,10 @@
     BHdr       : TBTreeHeader;
     block      : Array[0..2047] of Byte;
     i          : Integer;
+
 begin
    Result := nil;  SiteMap:=Nil;
+   lookup:=TDictionary<string,TLookupRec>.create;
    // First Try Binary
    Index := GetObject('/$WWKeywordLinks/BTree');
    if (Index = nil) or ForceXML then
@@ -1237,9 +1357,12 @@
      Exit;
    end;
    SiteMap:=TChmSitemap.Create(StIndex);
-   Item   :=Nil;  // cached last created item, in case we need to make
+   itemstack :=TObjectList.create(false);
+   //Item   :=Nil;  // cached last created item, in case we need to make
                   // a child.
-
+   parentitem:=sitemap.Items;
+   itemstack.add(parentitem); // level 0
+   curitemdepth:=0;
    TryTextual:=True;
    BHdr.LastLstBlock:=0;
    if LoadBtreeHeader(index,BHdr) and (BHdr.LastLstBlock>=0) Then
@@ -1248,7 +1371,7 @@
          begin
            for i:=0 to BHdr.lastlstblock do
              begin
-               if (index.size-index.position)>=defblocksize then
+               if (index.size-index.position)>=defblocksize then // skips last incomplete block?
                  begin
                    Index.read(block,defblocksize);
                    parselistingblock(@block)
@@ -1264,6 +1387,7 @@
       Result:=AbortAndTryTextual;
     end
   else Index.Free;
+  lookup.free;
 end;
 
 function TChmReader.GetTOCSitemap(ForceXML:boolean=false): TChmSiteMap;
@@ -1279,13 +1403,12 @@
       Item := SiteMapITems.NewItem;
       Props := LEtoN(TOC.ReadDWord);
       if (Props and TOC_ENTRY_HAS_LOCAL) = 0 then
-        Item.Text:= ReadStringsEntry(LEtoN(TOC.ReadDWord))
+        Item.AddName(ReadStringsEntry(LEtoN(TOC.ReadDWord)))
       else
       begin
         TopicsIndex := LEtoN(TOC.ReadDWord);
-        Item.Local := LookupTopicByID(TopicsIndex, Title);
-        Item.Text := Title;
-
+        Item.AddName(title);
+        Item.addLocal(LookupTopicByID(TopicsIndex, Title));
       end;
       TOC.ReadDWord;
       Result := LEtoN(TOC.ReadDWord);
@@ -1724,7 +1847,7 @@
   X: Integer;
 begin
   fOnOpenNewFile := AValue;
-  if AValue = nil then exit;
+  if not assigned(AValue)  then exit;
   for X := 0 to fUnNotifiedFiles.Count-1 do
     AValue(Self, X);
   fUnNotifiedFiles.Clear;
Index: packages/chm/src/chmsitemap.pas
===================================================================
--- packages/chm/src/chmsitemap.pas	(revision 42090)
+++ packages/chm/src/chmsitemap.pas	(working copy)
@@ -20,19 +20,63 @@
 }
 unit chmsitemap;
 
-{$mode objfpc}{$H+}
-
+{$mode Delphi}{$H+}
+{define preferlower}
 interface
 
 uses
-  Classes, SysUtils, fasthtmlparser;
+  Classes, SysUtils, fasthtmlparser, contnrs, strutils, generics.collections;
 
 type
   TChmSiteMapItems = class; // forward
   TChmSiteMap = class;
+  TChmSiteMapItem = class;
 
   { TChmSiteMapItem }
 
+  TChmSiteMapItemAttrName = (siteattr_NONE,
+                             siteattr_KEYWORD, // alias for name in sitemap
+                             siteattr_NAME,
+                             siteattr_LOCAL,
+                             siteattr_URL,
+                             siteattr_TYPE,
+                             siteattr_SEEALSO,
+                             siteattr_IMAGENUMBER,
+                             siteattr_NEW,
+                             siteattr_COMMENT,
+                             siteattr_MERGE,
+                             siteattr_FRAMENAME,
+                             siteattr_WINDOWNAME,
+                             siteattr_WINDOW_STYLES,
+                             siteattr_EXWINDOW_STYLES,
+                             siteattr_FONT,
+                             siteattr_IMAGELIST,
+                             siteattr_IMAGETYPE
+                            );
+
+  { TChmSiteMapSubItem }
+  TChmSiteMapGenerationOptions = (Default,emitkeyword);
+  TChmSiteMapSubItem = class(TPersistent)
+  private
+    FName,
+    FType,
+    FLocal,
+    FUrl,
+    FSeeAlso  : String;
+    FOwner : TChmSiteMapItem;
+  public
+    constructor Create(AOwner: TChmSiteMapItem);
+    destructor Destroy; override;
+  published
+    property Name : String read FName  write FName;  //hhk
+    property ItemType : String read FType write FType; //both
+    property Local: String read FLocal write FLocal; //both
+    property URL  : String read FURL write FURL;     //both
+    property SeeAlso: String read FSeeAlso write FSeeAlso; //hhk
+  end;
+
+// hhk items:  Merge | ([Name] ([Name] [Type...] [Local [URL] | See Also])... [FrameName] [WindowName] [Comment])
+// hhc items:  Merge | ([Name] ([Type...] [Local] [URL])... [FrameName] [WindowName] [Comment] [New] [ImageNumber])
   TChmSiteMapItem = class(TPersistent)
   private
     FChildren: TChmSiteMapItems;
@@ -39,35 +83,41 @@
     FComment: String;
     FImageNumber: Integer;
     FIncreaseImageIndex: Boolean;
-    FKeyWord: String;
-    FLocal: String;
     FOwner: TChmSiteMapItems;
-    FSeeAlso: String;
-    FText: String;
-    FURL: String;
+    FName   : String;
     FMerge : String;
     FFrameName : String;
     FWindowName : String;
+    FSubItems : TObjectList;
+    function getlocal: string;
+    function getseealso:string;
+    function getsubitem( index : integer): TChmSiteMapSubItem;
+    function getsubitemcount: integer;
     procedure SetChildren(const AValue: TChmSiteMapItems);
   public
     constructor Create(AOwner: TChmSiteMapItems);
     destructor Destroy; override;
+    procedure AddName(const Name:string);
+    procedure AddLocal(const Local:string);
+    procedure AddSeeAlso(const SeeAlso:string);
+    procedure AddURL(const URL:string);
+    procedure AddType(const AType:string);
+    procedure Sort(Compare: TListSortCompare);
   published
     property Children: TChmSiteMapItems read FChildren write SetChildren;
-    property Text: String read FText write FText; // Name for TOC; KeyWord for index
-    property KeyWord: String read FKeyWord write FKeyWord;
-    property Local: String read FLocal write FLocal;
-    property URL: String read FURL write FURL;
-    property SeeAlso: String read FSeeAlso write FSeeAlso;
+    property Name: String read FName write FName;
     property ImageNumber: Integer read FImageNumber write FImageNumber default -1;
     property IncreaseImageIndex: Boolean read FIncreaseImageIndex write FIncreaseImageIndex;
     property Comment: String read FComment write FComment;
     property Owner: TChmSiteMapItems read FOwner;
-
+    property Local : string read getlocal; // deprecated;             // should work on ALL pairs
+    property Text : string read fname write fname; // deprecated;     // should work on ALL pairs
+    property SeeAlso : string read getseealso; // deprecated;     // should work on ALL pairs
     property FrameName: String read FFrameName write FFrameName;
     property WindowName: String read FWindowName write FWindowName;
-//    property Type_: Integer read FType_ write FType_; either Local or URL
     property Merge: String read FMerge write FMerge;
+    property SubItem[ index :integer]:TChmSiteMapSubItem read getsubitem;
+    property SubItemcount  :integer read getsubitemcount;
   end;
 
   { TChmSiteMapItems }
@@ -80,8 +130,9 @@
     FParentItem: TChmSiteMapItem;
     function GetCount: Integer;
     function GetItem(AIndex: Integer): TChmSiteMapItem;
+    function getparentname: String;
     procedure SetItem(AIndex: Integer; const AValue: TChmSiteMapItem);
-  public
+public
     constructor Create(AOwner: TChmSiteMap; AParentItem: TChmSiteMapItem);
     destructor Destroy; override;
     procedure Delete(AIndex: Integer);
@@ -95,6 +146,7 @@
     property ParentItem: TChmSiteMapItem read FParentItem;
     property Owner: TChmSiteMap read FOwner;
     property InternalData: Dword read FInternalData write FInternalData;
+    property ParentName : String read getparentname;
   end;
   
 
@@ -130,7 +182,10 @@
     FLevel: Integer;
     FLevelForced: Boolean;
     FWindowStyles: LongInt;
+    FLoadDict : TDictionary<String,TChmSiteMapItemAttrName>;
+    fChmSiteMapGenerationOptions:TChmSiteMapGenerationOptions;
     procedure SetItems(const AValue: TChmSiteMapItems);
+    procedure CheckLookup;
   protected
     procedure FoundTag (ACaseInsensitiveTag, AActualTag: string);
     procedure FoundText(AText: string);
@@ -137,6 +192,7 @@
   public
     constructor Create(AType: TSiteMapType);
     destructor Destroy; override;
+    Procedure Sort(Compare: TListSortCompare);
     procedure LoadFromFile(AFileName: String);
     procedure LoadFromStream(AStream: TStream);
     procedure SaveToFile(AFileName:String);
@@ -155,11 +211,50 @@
     property UseFolderImages: Boolean read FUseFolderImages write FUseFolderImages;
     property Font: String read FFont write FFont;
     property AutoGenerated: Boolean read FAutoGenerated write FAutoGenerated;
+    property ChmSiteMapGenerationOptions : TChmSiteMapGenerationOptions read fChmSiteMapGenerationOptions write fChmSiteMapGenerationOptions;
   end;
 
+
+function indexitemcompare(Item1, Item2: Pointer): Integer;
 implementation
 uses HTMLUtil;
 
+const sitemapkws : array[TChmSiteMapItemAttrName] of string = (
+                    '',
+                    'KEYWORD',
+                    'NAME',
+                    'LOCAL',
+                    'URL',
+                    'TYPE',
+                    'SEE ALSO',
+                    'IMAGENUMBER',
+                    'NEW',
+                    'COMMENT',
+                    'MERGE',
+                    'FRAMENAME',
+                    'WINDOWNAME',
+                    'WINDOW STYLES',
+                    'EXWINDOW STYLES',
+                    'FONT',
+                    'IMAGELIST',
+                    'IMAGETYPE');
+
+function indexitemcompare(Item1, Item2: Pointer): Integer;
+begin
+    Result := naturalComparetext(LowerCase(TChmSiteMapItem(item1).name), Lowercase(TChmSiteMapItem(item2).name));
+end;
+{ TChmSiteMapSubItem }
+
+constructor TChmSiteMapSubItem.Create(AOwner: TChmSiteMapItem);
+begin
+  FOwner:=AOwner;
+end;
+
+destructor TChmSiteMapSubItem.Destroy;
+begin
+  inherited Destroy;
+end;
+
 { TChmSiteMapTree }
 
 procedure TChmSiteMap.SetItems(const AValue: TChmSiteMapItems);
@@ -168,6 +263,16 @@
   FItems:=AValue;
 end;
 
+procedure TChmSiteMap.CheckLookup;
+var en : TChmSiteMapItemAttrName;
+begin
+  if assigned(FLoadDict) then
+    exit;
+  FLoadDict :=TDictionary<String,TChmSiteMapItemAttrName>.Create;
+  for en:=succ(low(en)) to high(en) do
+    FLoadDict.add(sitemapkws[en],en);
+end;
+
 procedure TChmSiteMap.FoundTag(ACaseInsensitiveTag, AActualTag: string);
     procedure NewSiteMapItem;
     begin
@@ -196,131 +301,101 @@
       else FCurrentItems := nil;
       Dec(FLevel);
     end;
+
+// hhk items:  Merge | ([Name] ([Name] [Type...] [Local [URL] | See Also])... [FrameName] [WindowName] [Comment])
+// hhc items:  Merge | ([Name] ([Type...] [Local] [URL])... [FrameName] [WindowName] [Comment] [New] [ImageNumber])
 var
   TagName,
-  //TagAttribute,
   TagAttributeName,
   TagAttributeValue: String;
   isParam,IsMerged : string;
+  TagAttrName  : TChmSiteMapItemAttrName;
 begin
-  //WriteLn('TAG:', AActualTag);
   TagName := GetTagName(ACaseInsensitiveTag);
+  //WriteLn('GOT TAG: ', AActualTag);
+   if TagName = 'UL' then begin
+     //WriteLN('Inc Level');
+     IncreaseULevel;
+   end
+   else if TagName = '/UL' then begin
+     //WriteLN('Dec Level');
+     DecreaseULevel;
+   end
+   else if (TagName = 'LI') and (FLevel = 0) then
+     FLevelForced := True
+   else if TagName = 'OBJECT' then begin
+     Include(FSiteMapBodyTags, smbtOBJECT);
+     if FLevelForced then
+       IncreaseULevel;
+     If FLevel > 0 then // if it is zero it is the site properties
+       NewSiteMapItem;
+   end
+   else if TagName = '/OBJECT' then begin
+     Exclude(FSiteMapBodyTags, smbtOBJECT);
+     if FLevelForced then
+     begin
+       DecreaseULevel;
+       FLevelForced := False;
+     end;
+   end
+   else begin // we are the properties of the object tag
+     if (smbtOBJECT in FSiteMapBodyTags) then
+       begin
+        if (FLevel > 0 ) then
+         begin
+            if LowerCase(GetTagName(AActualTag)) = 'param' then begin
+              TagAttributeName := GetVal(AActualTag, 'name');
+              TagAttributeValue := GetVal(AActualTag, 'value');
 
-{  if not (smtHTML in FSiteMapTags) then begin
-    if (TagName = 'HTML') or (TagName = '/HTML') then Include(FSiteMapTags, smtHTML);
-  end
-  else begin // looking for /HTML
-    if TagName = '/HTML' then Exclude(FSiteMapTags, smtHTML);
-  end;}
+              // a hash reduces comparisons and casing, and generics make it easy.
+              if not FLoadDict.trygetvalue(uppercase(TagAttributeName),TagAttrName) then
+                 TagAttrName:=siteattr_none;
 
-  //if (smtHTML in FSiteMapTags) then begin
-     if not (smtBODY in FSiteMapTags) then begin
-       if TagName = 'BODY' then Include(FSiteMapTags, smtBODY);
-     end
-     else begin
-       if TagName = '/BODY' then Exclude(FSiteMapTags, smtBODY);
-     end;
-
-     if (smtBODY in FSiteMapTags) then begin
-       //WriteLn('GOT TAG: ', AActualTag);
-       if TagName = 'UL' then begin
-         //WriteLN('Inc Level');
-         IncreaseULevel;
-       end
-       else if TagName = '/UL' then begin
-         //WriteLN('Dec Level');
-         DecreaseULevel;
-       end
-       else if (TagName = 'LI') and (FLevel = 0) then
-         FLevelForced := True
-       else if TagName = 'OBJECT' then begin
-         Include(FSiteMapBodyTags, smbtOBJECT);
-         if FLevelForced then
-           IncreaseULevel;
-         If FLevel > 0 then // if it is zero it is the site properties
-           NewSiteMapItem;
-       end
-       else if TagName = '/OBJECT' then begin
-         Exclude(FSiteMapBodyTags, smbtOBJECT);
-         if FLevelForced then
-         begin
-           DecreaseULevel;
-           FLevelForced := False;
-         end;
-       end
-       else begin // we are the properties of the object tag
-         if (smbtOBJECT in FSiteMapBodyTags) then
-           begin
-            if (FLevel > 0 ) then 
+              if TagAttrName <> siteattr_none then begin
+                 case TagAttrName of
+                 siteattr_KEYWORD,
+                 siteattr_NAME         : Activeitem.AddName(TagAttributeValue);
+                 siteattr_LOCAL        : ActiveItem.AddLocal(TagAttributeValue);
+                 siteattr_URL          : ActiveItem.AddURL (TagAttributeValue);
+                 siteattr_TYPE         : ActiveItem.AddType (TagAttributeValue);
+                 siteattr_SEEALSO      : ActiveItem.AddSeeAlso(TagAttributeValue);
+                 siteattr_IMAGENUMBER  : ActiveItem.ImageNumber := StrToInt(TagAttributeValue);
+                 siteattr_NEW          : ActiveItem.IncreaseImageIndex := (LowerCase(TagAttributeValue) = 'yes');
+                 siteattr_COMMENT      : ActiveItem.Comment := TagAttributeValue;
+                 siteattr_MERGE        : ActiveItem.Merge:= TagAttributeValue;
+                 siteattr_FRAMENAME    : ActiveItem.FrameName:=TagAttributeValue;
+                 siteattr_WINDOWNAME   : ActiveItem.WindowName:=TagAttributeValue;
+                 end;
+              end;
+            end;
+         end
+       else
+         begin // object and level is zero?
+           if LowerCase(GetTagName(AActualTag)) = 'param' then begin
              begin
-                if LowerCase(GetTagName(AActualTag)) = 'param' then begin
-                  TagAttributeName := GetVal(AActualTag, 'name');
-                TagAttributeValue := GetVal(AActualTag, 'value');
-                //writeln('name,value',tagattributename, ' ',tagattributevalue);
-                if TagAttributeName <> '' then begin
-                  if CompareText(TagAttributeName, 'keyword') = 0 then begin
-                    ActiveItem.Text := TagAttributeValue;
-                  end
-                  else if CompareText(TagAttributeName, 'name') = 0 then begin
-                    if ActiveItem.Text = '' then ActiveItem.Text := TagAttributeValue;
-                  end
-                  else if CompareText(TagAttributeName, 'local') = 0 then begin
-                    ActiveItem.Local := TagAttributeValue;
-                  end
-                  else if CompareText(TagAttributeName, 'URL') = 0 then begin
-                    ActiveItem.URL := TagAttributeValue;
-                  end
-                  else if CompareText(TagAttributeName, 'ImageNumber') = 0 then begin
-                    ActiveItem.ImageNumber := StrToInt(TagAttributeValue);
-                  end
-                  else if CompareText(TagAttributeName, 'New') = 0 then begin
-                    ActiveItem.IncreaseImageIndex := (LowerCase(TagAttributeValue) = 'yes');
-                  end
-                  else if CompareText(TagAttributeName, 'Comment') = 0 then begin
-                    ActiveItem.Comment := TagAttributeValue
-                  end
-                  else if CompareText(TagAttributeName, 'Merge') = 0 then begin
-                    ActiveItem.Merge:= TagAttributeValue
-                  end;
-                  //else if CompareText(TagAttributeName, '') = 0 then begin
-                  //end;
-                end;
-              end;
-            end
-           else
-             begin // object and level is zero?
-               if LowerCase(GetTagName(AActualTag)) = 'param' then begin
-                 begin
-                   TagAttributeName := uppercase(GetVal(AActualTag, 'name'));
-                   TagAttributeValue := GetVal(AActualTag, 'value');
-                   if TagAttributeName = 'FRAMENAME' then
-                     framename:=TagAttributeValue
-                   else
-                     if TagAttributeName = 'WINDOWNAME' then
-                       WINDOWname:=TagAttributeValue
-                   else
-                     if TagAttributeName = 'WINDOW STYLES' then
-                       WindowStyles:=StrToIntDef(TagAttributeValue,0)
-                   else
-                     if TagAttributeName = 'EXWINDOW STYLES' then
-                       ExWindowStyles:=StrToIntDef(TagAttributeValue,0)
-                   else
-                     if TagAttributeName = 'FONT' then
-                       FONT:=TagAttributeValue
-                   else
-                     if TagAttributeName = 'IMAGELIST' then
-                      IMAGELIST:=TagAttributeValue
-                    else
-                     if TagAttributeName = 'IMAGETYPE' then
-                      UseFolderImages:=uppercase(TagAttributeValue)='FOLDER';
-                  // writeln('0:',flevel,' ' ,aactualtag,' ',tagname,' ' ,tagattributename, ' ' ,tagattributevalue);
-                 end;
-                 end;
+               TagAttributeName := uppercase(GetVal(AActualTag, 'name'));
+               TagAttributeValue := GetVal(AActualTag, 'value');
+               if not FLoadDict.trygetvalue(uppercase(TagAttributeName),TagAttrName) then
+                  TagAttrName:=siteattr_none;
+               if TagAttrName <> siteattr_none then begin
+                  case TagAttrName of
+                   siteattr_FRAMENAME       : FrameName:=TagAttributeValue;
+                   siteattr_WINDOWNAME      : WindowName:=TagAttributeValue;
+                   siteattr_WINDOW_STYLES   : WindowStyles:=StrToIntDef(TagAttributeValue,0);
+                   siteattr_EXWINDOW_STYLES : ExWindowStyles:=StrToIntDef(TagAttributeValue,0);
+                   siteattr_FONT            : Font:=TagAttributeValue;
+                   siteattr_IMAGELIST       : ImageList:=TagAttributeValue;
+                   siteattr_IMAGETYPE       : UseFolderImages:=uppercase(TagAttributeValue)='FOLDER';
+                   end;
              end;
-          end;
-       end;
-     end;
-  //end
+              // writeln('0:',flevel,' ' ,aactualtag,' ',tagname,' ' ,tagattributename, ' ' ,tagattributevalue);
+             end;
+             end;
+         end;
+      end;
+   end;
+// end; {body}
+  //end   {html}
 end;
 
 procedure TChmSiteMap.FoundText(AText: string);
@@ -342,14 +417,22 @@
 begin
   if Assigned(FHTMLParser) then FHTMLParser.Free;
   FItems.Free;
+  FLoadDict.Free;
+
   Inherited Destroy;
 end;
 
+procedure TChmSiteMap.Sort(Compare: TListSortCompare);
+begin
+  FItems.sort(compare);
+end;
+
 procedure TChmSiteMap.LoadFromFile(AFileName: String);
 var
   Buffer: String;
   TmpStream: TMemoryStream;
 begin
+  CheckLookup;
   if Assigned(FHTMLParser) then FHTMLParser.Free;
   TmpStream := TMemoryStream.Create;
   try
@@ -362,8 +445,8 @@
   end;
   FHTMLParser := THTMLParser.Create(Buffer);
   try
-    FHTMLParser.OnFoundTag := @FoundTag;
-    FHTMLParser.OnFoundText := @FoundText;
+    FHTMLParser.OnFoundTag := FoundTag;
+    FHTMLParser.OnFoundText := FoundText;
     FHTMLParser.Exec;
   finally
     FreeAndNil(FHTMLParser);
@@ -374,12 +457,13 @@
 var
   Buffer: String;
 begin
+  CheckLookup;
   if Assigned(FHTMLParser) then FHTMLParser.Free;
   SetLength(Buffer, AStream.Size-AStream.Position);
   if AStream.Read(Buffer[1], AStream.Size-AStream.Position) > 0 then begin;
     FHTMLParser := THTMLParser.Create(Buffer);
-    FHTMLParser.OnFoundTag := @FoundTag;
-    FHTMLParser.OnFoundText := @FoundText;
+    FHTMLParser.OnFoundTag := FoundTag;
+    FHTMLParser.OnFoundText := FoundText;
     FHTMLParser.Exec;
     FreeAndNil(FHTMLParser);
   end;
@@ -397,6 +481,9 @@
     end;
 end;
 
+// hhk items:  Merge | ([Name] ([Name] [Type...] [Local [URL] | See Also])... [FrameName] [WindowName] [Comment])
+// hhc items:  Merge | ([Name] ([Type...] [Local] [URL])... [FrameName] [WindowName] [Comment] [New] [ImageNumber])
+
 procedure TChmSiteMap.SaveToStream(AStream: TStream);
 var
   Indent: Integer;
@@ -408,6 +495,13 @@
      AStream.Write(AString[1], Length(AString));
      AStream.WriteByte(10);
   end;
+  procedure WriteStringNoIndent(AString: String);
+  var
+    I: Integer;
+  begin
+     AStream.Write(AString[1], Length(AString));
+  end;
+
   procedure WriteParam(AName: String; AValue: String);
   begin
     WriteString('<param name="'+AName+'" value="'+AValue+'">');
@@ -414,38 +508,73 @@
   end;
   procedure WriteEntries(AItems: TChmSiteMapItems);
   var
-    I : Integer;
+    I,J : Integer;
     Item: TChmSiteMapItem;
+    Sub : TChmSiteMapSubItem;
+    lemitkeyword : boolean;
   begin
+    lemitkeyword:=ChmSiteMapGenerationOptions=emitkeyword;
     for I := 0 to AItems.Count-1 do begin
       Item := AItems.Item[I];
+
+      {$ifdef preferlower}
+      WriteString('<li> <object type="text/sitemap">');
+      {$else}
       WriteString('<LI> <OBJECT type="text/sitemap">');
+      {$endif}
       Inc(Indent, 8);
 
-      if (SiteMapType = stIndex) and ((Item.Children.Count > 0) or (item.seealso<>'')) then
-         WriteParam('Keyword', Item.Text);
-      //if Item.KeyWord <> '' then WriteParam('Keyword', Item.KeyWord);
-      if Item.Text <> '' then WriteParam('Name', Item.Text);
-      if (Item.Local <> '') or (SiteMapType = stIndex) then WriteParam('Local', StringReplace(Item.Local, '\', '/', [rfReplaceAll]));
-      if Item.URL <> '' then WriteParam('URL', StringReplace(Item.URL, '\', '/', [rfReplaceAll]));
-      if (SiteMapType = stIndex) and (Item.SeeAlso <> '') then WriteParam('See Also', Item.SeeAlso);
-      //if Item.FrameName <> '' then WriteParam('FrameName', Item.FrameName);
-      //if Item.WindowName <> '' then WriteParam('WindowName', Item.WindowName);
+      if Item.Name<>'' then
+        begin
+          if lemitkeyword then
+            WriteParam('Keyword', item.Name)
+          else
+            WriteParam('Name', Item.Name);
+        end;
+
+      if item.FSubItems.count>0 then
+        begin
+          For j:=0 to item.FSubItems.count-1 do
+            begin
+              Sub:=TChmSiteMapSubItem(item.fsubitems[j]);
+              if Sub.Name <> ''     then WriteParam('Name', Sub.Name);
+              if Sub.ItemType <> '' then WriteParam('Type', Sub.ItemType);
+              if Sub.Local <> ''    then WriteParam('Local', Sub.Local);
+              if Sub.URL <> ''      then WriteParam('URL', Sub.URL);
+              if Sub.SeeAlso <> ''  then WriteParam('See Also', Sub.SeeAlso);
+            end;
+        end;
+      if Item.FrameName <> '' then WriteParam('FrameName', Item.FrameName);
+      if Item.WindowName <> '' then WriteParam('WindowName', Item.WindowName);
       if Item.Comment <> '' then WriteParam('Comment', Item.Comment);
-      if (SiteMapType = stTOC) and (Item.IncreaseImageIndex) then WriteParam('New', 'yes'); // is this a correct value?
-      if (SiteMapType = stTOC) and (Item.ImageNumber <> -1) then WriteParam('ImageNumber', IntToStr(Item.ImageNumber));
-
+      if (SiteMapType = stTOC) and (Item.IncreaseImageIndex) then
+          WriteParam('New', 'yes'); // is this a correct value?
+      if (SiteMapType = stTOC) and (Item.ImageNumber <> -1) then
+          WriteParam('ImageNumber', IntToStr(Item.ImageNumber));
       Dec(Indent, 3);
+      {$ifdef preferlower}
+      WriteString('</object>');
+      {$else}
       WriteString('</OBJECT>');
+      {$endif}
       Dec(Indent, 5);
 
       // Now Sub Entries
       if Item.Children.Count > 0 then begin
-        WriteString('<UL>');
+        {$ifdef preferlower}
+        WriteString('<ul>');
+        {$else}
+        WriteString('<UL> ');
+        {$endif}
         Inc(Indent, 8);
         WriteEntries(Item.Children);
         Dec(Indent, 8);
-        WriteString('</UL>');
+        {$ifdef preferlower}
+        WriteString('</ul>');
+        {$else}
+        WriteString('</UL>'); //writestringnoident
+        {$endif}
+
       end;
     end;
   end;
@@ -501,19 +630,137 @@
   FChildren := AValue;
 end;
 
+function TChmSiteMapItem.getlocal: string;
+begin
+  result:='';
+  if FSubItems.count>0 then
+     result:=TChmSiteMapSubItem(FSubItems[0]).local;
+end;
+
+function TChmSiteMapItem.getseealso: string;
+begin
+  result:='';
+  if FSubItems.count>0 then
+    result:=TChmSiteMapSubItem(FSubItems[FSubItems.count-1]).SeeAlso;
+end;
+
+function TChmSiteMapItem.getsubitem( index : integer): TChmSiteMapSubItem;
+begin
+  result:=nil;
+  if index<FSubItems.count then
+    result:=TChmSiteMapSubItem(FSubItems[index]);
+end;
+
+function TChmSiteMapItem.getsubitemcount: integer;
+begin
+   result:=FSubItems.count;
+end;
+
 constructor TChmSiteMapItem.Create(AOwner: TChmSiteMapItems);
 begin
   Inherited Create;
   FOwner := AOwner;
   FChildren := TChmSiteMapItems.Create(Owner.Owner, Self);
+  FSubItems := TObjectList.Create(true);
+  imagenumber:=-1;
 end;
 
 destructor TChmSiteMapItem.Destroy;
 begin
+  fsubitems.Free;
   FChildren.Free;
   Inherited Destroy;
 end;
 
+procedure TChmSiteMapItem.AddName(const Name: string);
+var sub :TChmSiteMapSubItem;
+begin
+  if fname='' then
+    fname:=name
+  else
+    begin
+      sub :=TChmSiteMapSubItem.create(self);
+      FSubItems.add(sub);
+      sub.Name:=Name;
+    end;
+end;
+
+procedure TChmSiteMapItem.AddLocal(const Local: string);
+var sub :TChmSiteMapSubItem;
+    addnew : boolean;
+begin
+   if fsubitems.count>0 then
+      begin
+        sub:=TChmSiteMapSubItem(fsubitems[FSubItems.count-1]);
+        if sub.FLocal<>'' then
+          begin
+            sub.flocal:=local;
+            exit;
+          end;
+      end;
+   sub :=TChmSiteMapSubItem.create(self);
+   FSubItems.add(sub);
+//   sub.name:=name;
+   sub.Local:=Local;
+end;
+
+procedure TChmSiteMapItem.AddSeeAlso(const SeeAlso: string);
+// see also is mutually exclusive with "local url", so addition procedure is same as "local"
+var sub :TChmSiteMapSubItem;
+begin
+   if fsubitems.count>0 then
+      begin
+        sub:=TChmSiteMapSubItem(fsubitems[FSubItems.count-1]);
+        if sub.FSeeAlso<>'' then
+          begin
+            sub.FSeeAlso:=SeeAlso;
+            exit;
+          end;
+      end;
+   sub :=TChmSiteMapSubItem.create(self);
+   FSubItems.add(sub);
+   sub.FSeeAlso:=SeeAlso;
+end;
+
+
+procedure TChmSiteMapItem.AddURL(const URL: string);
+var sub :TChmSiteMapSubItem;
+begin
+   if fsubitems.count>0 then
+      begin
+        sub:=TChmSiteMapSubItem(fsubitems[FSubItems.count-1]);
+        if sub.FURL<>'' then
+          begin
+            sub.fURL:=URL;
+            exit;
+          end;
+      end
+   { else not possible according to chmspec. An URL must always follow a "local" item}
+end;
+
+procedure TChmSiteMapItem.AddType(const AType: string);
+// in Tocs, Type can be the first is the same as local
+var sub :TChmSiteMapSubItem;
+begin
+   if fsubitems.count>0 then
+      begin
+        sub:=TChmSiteMapSubItem(fsubitems[FSubItems.count-1]);
+        if sub.ItemType<>'' then
+          begin
+            sub.ItemType:=AType;
+            exit;
+          end;
+      end;
+   sub :=TChmSiteMapSubItem.create(self);
+   FSubItems.add(sub);
+   sub.ItemType:=AType;
+end;
+
+procedure TChmSiteMapItem.Sort(Compare: TListSortCompare);
+begin
+  FChildren.sort(compare);
+end;
+
 { TChmSiteMapItems }
 
 function TChmSiteMapItems.GetItem(AIndex: Integer): TChmSiteMapItem;
@@ -521,6 +768,15 @@
   Result := TChmSiteMapItem(FList.Items[AIndex]);
 end;
 
+function TChmSiteMapItems.getparentname: String;
+begin
+  result:='Not assigned';
+  if assigned(fparentitem) then
+    begin
+      result:=FParentItem.name;
+    end;
+end;
+
 function TChmSiteMapItems.GetCount: Integer;
 begin
   Result := FList.Count;
@@ -577,8 +833,11 @@
 end;
 
 procedure TChmSiteMapItems.Sort(Compare: TListSortCompare);
+var I :Integer;
 begin
   FList.Sort(Compare);
+  for i:=0 to flist.Count-1 do
+    TChmSiteMapItem(flist[i]).sort(Compare)
 end;
 
 end.
Index: packages/chm/src/chmwriter.pas
===================================================================
--- packages/chm/src/chmwriter.pas	(revision 42090)
+++ packages/chm/src/chmwriter.pas	(working copy)
@@ -6,7 +6,7 @@
   option) any later version.
 
   This program is distributed in the hope that it will be useful, but WITHOUT
-  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+    ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
   FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
   for more details.
 
@@ -22,7 +22,7 @@
 {$MODE OBJFPC}{$H+}
 
 interface
-uses Classes, ChmBase, chmtypes, chmspecialfiles, HtmlIndexer, chmsitemap, contnrs, StreamEx, Avl_Tree, lzxcompressthread;
+uses Generics.Collections,Classes, ChmBase, chmtypes, chmspecialfiles, HtmlIndexer, chmsitemap, contnrs, StreamEx, Avl_Tree, lzxcompressthread;
 
 Const
    DefaultHHC = 'Default.hhc';
@@ -154,6 +154,7 @@
     FAvlStrings   : TAVLTree;    // dedupe strings
     FAVLTopicdedupe : TAVlTree;  // Topic deduping, if we load it both from hhp and TOC
     FAvlURLStr    : TAVLTree;    // dedupe urltbl + binindex must resolve URL to topicid
+    FDictTopicsUrlInd    : specialize TDictionary<string,integer>; // if url exists reuse topic.
     SpareString   : TStringIndex;
     SpareUrlStr   : TUrlStrIndex;
     FWindows      : TObjectList;
@@ -164,6 +165,7 @@
     FTocSM        : TCHMSitemap;
     FHasKLinks    : Boolean;
     FNrTopics     : Integer;
+
   protected
     procedure FileAdded(AStream: TStream; const AEntry: TFileEntryRec); override;
   private
@@ -186,6 +188,7 @@
     function AddURL(AURL: String; TopicsIndex: DWord): LongWord;
     procedure CheckFileMakeSearchable(AStream: TStream; AFileEntry: TFileEntryRec);
     function AddTopic(ATitle,AnUrl:AnsiString;code:integer=-1):integer;
+    function AddTopicindex(ATitle,AnUrl:AnsiString;code:integer=-1):integer;
     procedure ScanSitemap(asitemap:TCHMSiteMap);
     function NextTopicIndex: Integer;
     procedure Setwindows (AWindowList:TObjectList);
@@ -1521,6 +1524,7 @@
   FDefaultWindow:= '';
   FMergeFiles   :=TStringList.Create;
   FNrTopics     :=0;
+  FDictTopicsUrlInd    :=specialize TDictionary<string,integer>.Create;
 end;
 
 destructor TChmWriter.Destroy;
@@ -1543,7 +1547,7 @@
   FAVLTopicdedupe.FreeAndClear;
   FAVLTopicdedupe.free;
   FWindows.Free;
-
+  FDictTopicsUrlInd.Free;
   inherited Destroy;
 end;
 
@@ -1664,6 +1668,7 @@
     TopicEntry: TTopicEntry;
 
 begin
+    ATitle :=StringReplace(Atitle, '&x27;', '', [rfReplaceAll]);
     anurl:=StringReplace(anurl, '\', '/', [rfReplaceAll]);
     if ATitle <> '' then
       TopicEntry.StringsOffset := AddString(ATitle)
@@ -1691,8 +1696,35 @@
     FTopicsStream.WriteDWord(LEtoN(TopicEntry.URLTableOffset));
     FTopicsStream.WriteWord(LEtoN(TopicEntry.InContents));
     FTopicsStream.WriteWord(LEtoN(TopicEntry.Unknown));
+    {$ifdef binindex}
+    writeln('topout:',result, ' ' , TopicEntry.StringsOffset,' ' ,TopicEntry.URLTableOffset, ' ',atitle,' - ', anurl);
+    {$endif}
 end;
 
+function TChmWriter.AddTopicindex(ATitle, AnUrl: AnsiString; code: integer
+  ): integer;
+
+begin
+   ATitle :=StringReplace(Atitle, '&x27;', '', [rfReplaceAll]);
+
+  // adhoc subsitutions. Replace with real code if exact behaviour is known.
+{  Atitle:=StringReplace(atitle, '&x27;', '''', [rfReplaceAll]);
+  if length(atitle)>0 then
+    atitle[1]:=uppercase(atitle[1])[1];}
+  {$ifdef binindex}
+  writeln('Enter ',ATitle,' ',AnUrl);
+  {$endif}
+  if FDictTopicsUrlInd.trygetvalue(anurl,result) then
+   begin
+     writeln('found:',result);
+   end
+   else
+    begin
+      result:=addtopic(atitle,anurl);
+      FDictTopicsUrlInd.add(anurl,result);
+    end;
+end;
+
 procedure TChmWriter.ScanSitemap(asitemap:TCHMSiteMap);
 procedure scanitems(it:TChmSiteMapItems);
 
@@ -2039,32 +2071,60 @@
   inc(blockind,indexentrysize);
 end;
 
-procedure CreateEntry(Item:TChmSiteMapItem;Str:WideString;commaatposition:integer);
+procedure WritestrNT(var p:pbyte;const str:Unicodestring);
+var i : integer;
+    p2 : pbyte;
+begin
+  p2:=p;
+  for i:=1 to Length(str) do
+    WriteWord(p2,Word(str[i]));   // write the wstr in little endian
+  WriteWord(p2,0);                // NT
+  p:=p2;
+end;
 
+procedure CreateEntry(Item:TChmSiteMapItem;const Str:UnicodeString;commaatposition,level:integer);
+
 var p      : pbyte;
     topicid: integer;
     seealso: Integer;
     entrysize:Integer;
     i      : Integer;
+    sb :TChmSiteMapSubItem;
 begin
   inc(TotalEntries);
   fillchar(testblock[0],DefBlockSize,#0);
   p:=@TestBlock[0];
-  for i:=1 to Length(str) do
-    WriteWord(p,Word(str[i]));   // write the wstr in little endian
-  WriteWord(p,0);                // NT
-//  if item.seealso='' then    // no seealso for now
-    seealso:=0;
- // else
-//    seealso:=2;
+
+  WritestrNT(p,Str);
+  if item.seealso='' then    // no seealso for now
+    seealso:=0
+   else
+    seealso:=2;
   WriteWord(p,seealso);          // =0 not a see also 2 =seealso
-  WriteWord(p,0);                // Entrydepth.  We can't know it, so write 2.
+  WriteWord(p,level);            // Entrydepth.  We can't know it, so write 2.
   WriteDword(p,commaatposition); // position of the comma
   WriteDword(p,0);               // unused 0
-  WriteDword(p,1);               // for now only local pair.
-  TopicId:=AddTopic(Item.Text,item.Local);
-  WriteDword(p,TopicId);
-  // if seealso then _here_ a wchar NT string with seealso?
+
+  if seealso=2 then
+   begin
+     write('!seealso');
+     WriteDword(p,1);
+     WritestrNT(p,item.seealso)
+   end
+  else
+    begin
+      WriteDword(p,item.SubItemcount);
+      for i:=0 to item.SubItemcount-1 do
+        begin
+          sb:=item.SubItem[i];
+          if sb.name='' then
+            sb.name:=item.name;
+          writeln('---',sb.name,' ',sb.local);
+          TopicId:=AddTopicIndex(sb.Name,sb.Local);
+          WriteDword(p,TopicId);
+        end;
+    end;
+
   WriteDword(p,1);               // always 1 (unknown);
   WriteDword(p,mod13value);      //a value that increments with 13.
   mod13value:=mod13value+13;
@@ -2158,32 +2218,36 @@
   Result:=blk-start;
 end;
 
-procedure CombineWithChildren(ParentItem:TChmSiteMapItem;Str:WideString;commaatposition:integer;first:boolean);
+procedure CombineWithChildren(ParentItem:TChmSiteMapItem;Str:UnicodeString;commaatposition:integer;level:integer);
 var i    : Integer;
-    Item : TChmSiteMapItem;
+    llItem : TChmSiteMapItem;
 begin
-  if ParentItem.Children.Count = 0 Then
-    Begin
+   str:=StringReplace(str, '&x27;', '', [rfReplaceAll]);
+   {$ifdef binindex}
+     writeln('i:',level,' ',str);
+   {$endif}
+//  if ParentItem.Children.Count = 0 Then
+//    Begin
      // comment/fix next
      //   if commatposition=length(str) then commaatposition:=0;
-       if first then
-        CreateEntry(ParentItem,Str,0)
+       if level=0 then
+        CreateEntry(ParentItem,Str,0,level)
        else
-        CreateEntry(ParentItem,Str,commaatposition);
-    End
-  Else
+        CreateEntry(ParentItem,Str,commaatposition,level);
+//    End
+//  Else
     for i:=0 to ParentItem.Children.Count-1 do
       begin
-        item := TChmSiteMapItem(ParentItem.Children.Item[i]);
-        if first Then
-          CombineWithChildren(Item,Str+', '+item.text,commaatposition+2,false)
-        else
-          CombineWithChildren(Item,Str+', '+item.text,commaatposition,false);
+        llitem := TChmSiteMapItem(ParentItem.Children.Item[i]);
+{        if level=0 Then
+          CombineWithChildren(Item,str+', '+item.text,0,level+1)
+        else}
+          CombineWithChildren(llItem,Str+', '+llitem.text,length(str)+2,level+1);
       end;
 end;
 
 Var i             : Integer;
-    Key           : WideString;
+    Key           : UnicodeString;
     Item          : TChmSiteMapItem;
     ListingBlocks : Integer;
     EntryBytes    : Integer;
@@ -2204,6 +2268,7 @@
   {$ifdef binindex}
     writeln('starting index');
   {$endif}
+  ASiteMap.sort(@indexitemcompare);
   IndexStream:=TMemoryStream.Create;
   indexstream.size:=sizeof(TBTreeHeader);
   IndexStream.position:=Sizeof(TBTreeHeader);
@@ -2251,7 +2316,7 @@
       // so we can see if Windows loads the binary or textual index.
       CombineWithChildren(Item,Key+'2',length(key)+1,true);
       {$else}
-      CombineWithChildren(Item,Key,length(key),true);
+      CombineWithChildren(Item,Key,length(key),0);
       {$endif}
     end;
   PrepareCurrentBlock(True);     // flush last listing block.
@@ -2420,7 +2485,6 @@
   PostAddStreamToArchive(AName, '/', AStream);
 end;
 
-
 procedure TChmWriter.AddContext(AContext: DWord; ATopic: String);
 var
   Offset: DWord;
@@ -2448,7 +2512,6 @@
 end;
 
 procedure TChmWriter.Setwindows(AWindowList: TObjectList);
-
 var i : integer;
     x : TCHMWindow;
 begin
Index: utils/fpdoc/dw_htmlchm.inc
===================================================================
--- utils/fpdoc/dw_htmlchm.inc	(revision 42090)
+++ utils/fpdoc/dw_htmlchm.inc	(working copy)
@@ -192,12 +192,12 @@
         // by unit
         TmpItem := ObjUnitItem.Children.NewItem;
         TmpItem.Text := Element.Name;
-        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(Element, 0));
+        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(Element, 0)));
         
         //alpha
         TmpItem := GetAlphaItem(AlphaObjItem.Children, UpperCase(Copy(Element.Name, 1, 2))).Children.NewItem;
         TmpItem.Text := Element.Name;
-        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(Element, 0));
+        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(Element, 0)));
         
       end;
       
@@ -208,12 +208,12 @@
         // by unit
         TmpItem := RoutinesUnitItem.Children.NewItem;
         TmpItem.Text := Element.Name;
-        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(Element, 0));
+        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(Element, 0)));
         
         // alpha
         TmpItem := GetAlphaItem(AlphaRoutinesItem.Children, UpperCase(Element.Name[1])).Children.NewItem;
         TmpItem.Text := Element.Name;
-        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(Element, 0));
+        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(Element, 0)));
       end;
     end;
   end;
@@ -305,7 +305,7 @@
         continue;
       ParentItem := Index.Items.NewItem;
       ParentItem.Text := AModule.Name;
-      ParentItem.Local := FixHTMLpath(Allocator.GetFilename(AModule, 0));
+      ParentItem.addLocal(FixHTMLpath(Allocator.GetFilename(AModule, 0)));
 
       //  classes
       for j := 0 to AModule.InterfaceSection.Classes.Count-1 do
@@ -313,7 +313,7 @@
         ParentElement := TPasClassType(AModule.InterfaceSection.Classes[j]);
         ParentItem := Index.Items.NewItem;
         ParentItem.Text := ParentELement.Name;
-        ParentItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
+        ParentItem.addLocal(FixHTMLpath(Allocator.GetFilename(ParentElement, 0)));
         for k := 0 to TPasClassType(ParentElement).Members.Count-1 do
         begin
           TmpElement := TPasElement(TPasClassType(ParentElement).Members.Items[k]);
@@ -336,11 +336,11 @@
             cmtInterface   : TmpItem.Text := TmpElement.Name + ' interface';
             cmtUnknown     : TmpItem.Text := TmpElement.Name;
           end;
-          TmpItem.Local := FixHTMLpath(Allocator.GetFilename(TmpElement, 0));
+          TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(TmpElement, 0)));
           if (trim(s)<>'') and (tmpitem.local<>s) then
             begin
               writeln('Hint: Index: Resolved:',tmpitem.local,' to ',s);
-              tmpitem.local:=s;
+              tmpitem.addLocal(s);
             end;
 
           {
@@ -350,11 +350,11 @@
           MemberItem := nil;
           MemberItem := GetAlphaItem(Index.Items, TmpElement.Name);
           // ahh! if MemberItem.Local is empty MemberType is not shown!
-          MemberItem.Local := FixHTMLpath(Allocator.GetFilename(TmpElement, 0));
+          MemberItem.addLocal(FixHTMLpath(Allocator.GetFilename(TmpElement, 0)));
 
           TmpItem := MemberItem.Children.NewItem;
           TmpItem.Text := ParentElement.Name;
-          TmpITem.Local := FixHTMLpath(Allocator.GetFilename(TmpElement, 0));
+          TmpITem.addLocal(FixHTMLpath(Allocator.GetFilename(TmpElement, 0)));
         end;
       end;
       // routines
@@ -363,7 +363,7 @@
         ParentElement := TPasProcedureType(AModule.InterfaceSection.Functions[j]);
         TmpItem := Index.Items.NewItem;
         TmpItem.Text := ParentElement.Name + ' ' + ParentElement.ElementTypeName;
-        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
+        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(ParentElement, 0)));
       end;
       // consts
       for j := 0 to AModule.InterfaceSection.Consts.Count-1 do
@@ -371,7 +371,7 @@
         ParentElement := TPasElement(AModule.InterfaceSection.Consts[j]);
         TmpItem := Index.Items.NewItem;
         TmpItem.Text := ParentElement.Name;
-        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
+        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(ParentElement, 0)));
       end;
       // types
       for j := 0 to AModule.InterfaceSection.Types.Count-1 do
@@ -379,7 +379,7 @@
         ParentElement := TPasType(AModule.InterfaceSection.Types[j]);
         TmpItem := Index.Items.NewItem;
         TmpItem.Text := ParentElement.Name;
-        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
+        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(ParentElement, 0)));
         // enums
         if ParentELement is TPasEnumType then
         begin
@@ -390,11 +390,11 @@
             // subitem
             TmpItem := ParentItem.Children.NewItem;
             TmpItem.Text := TmpElement.Name;
-            TmpItem.Local := ParentItem.Local;
+            TmpItem.addLocal(ParentItem.Local);
             // root level
             TmpItem := Index.Items.NewItem;
             TmpItem.Text := TmpElement.Name;
-            TmpItem.Local := ParentItem.Local;
+            TmpItem.addLocal(ParentItem.Local);
           end;
         end;
       end;
@@ -404,7 +404,7 @@
         ParentElement := TPasElement(AModule.InterfaceSection.Variables[j]);
         TmpItem := Index.Items.NewItem;
         TmpItem.Text := ParentElement.Name + ' var';
-        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
+        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(ParentElement, 0)));
       end;
       // declarations
       {
chmworking.patch (57,390 bytes)

Marco van de Voort

2019-05-25 22:48

manager   ~0116416

A cleaned up version of the patch has been committed to trunk.

Issue History

Date Modified Username Field Change
2018-08-31 05:20 eri0o New Issue
2018-08-31 13:04 wp Note Added: 0110404
2018-08-31 13:04 wp Note Edited: 0110404 View Revisions
2018-08-31 13:05 wp Note Edited: 0110404 View Revisions
2018-08-31 13:06 wp Note Edited: 0110404 View Revisions
2018-08-31 15:42 eri0o Note Added: 0110408
2018-08-31 16:43 wp Note Added: 0110411
2018-08-31 17:59 Sven Barth Note Added: 0110415
2018-08-31 19:16 wp Note Added: 0110418
2018-08-31 19:33 eri0o Note Added: 0110421
2018-08-31 21:20 Marco van de Voort Note Added: 0110424
2018-08-31 21:21 Sven Barth Note Added: 0110425
2018-08-31 21:52 Marco van de Voort Note Added: 0110427
2018-08-31 21:52 Marco van de Voort Note Edited: 0110427 View Revisions
2018-09-01 04:57 eri0o Note Added: 0110432
2018-09-01 05:00 eri0o Note Edited: 0110432 View Revisions
2018-09-01 13:16 Marco van de Voort Note Added: 0110436
2018-09-01 14:01 Jeppe Johansen Note Added: 0110438
2018-09-01 14:01 Jeppe Johansen File Added: chm_fixes.patch
2018-09-01 17:07 eri0o Note Added: 0110448
2018-09-01 17:37 Jeppe Johansen Note Added: 0110449
2018-09-01 20:34 Marco van de Voort Note Added: 0110453
2018-09-01 21:24 Marco van de Voort File Added: hhex2.pp
2018-09-01 21:37 Marco van de Voort File Added: hhex3.pp
2018-09-01 21:51 Jeppe Johansen Note Added: 0110454
2018-09-02 13:39 Marco van de Voort Note Added: 0110459
2018-09-02 16:06 Marco van de Voort Note Added: 0110460
2018-09-02 16:08 Marco van de Voort Note Edited: 0110460 View Revisions
2018-09-05 04:30 eri0o Note Added: 0110509
2018-10-25 14:50 eri0o Note Added: 0111554
2018-10-25 20:26 Anton Kavalenka Note Added: 0111556
2019-05-07 14:26 Marco van de Voort Tag Attached: chm
2019-05-10 09:06 Marco van de Voort Assigned To => Marco van de Voort
2019-05-10 09:06 Marco van de Voort Status new => assigned
2019-05-19 10:08 Marco van de Voort File Added: chmworking.patch
2019-05-19 10:08 Marco van de Voort Note Added: 0116257
2019-05-19 10:10 Marco van de Voort Note Edited: 0116257 View Revisions
2019-05-25 22:48 Marco van de Voort Note Added: 0116416