* redone sitemap to support multiple name,local pairs for index.

 * rewritten binary index generation. Use natural sort for index.
 * updated html scanning for ID= tags as anchor, reduces warnings with more modern html code.
 
Still work to do, ags helpfile still has 70 differences. Possibly however due to case sensitive anchors on index level.

git-svn-id: trunk@42124 -

packages/chm/fpmake.pp

@@ -31,6 +31,7 @@ begin
 
     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');

packages/chm/src/chmcmd.lpr

@@ -145,7 +145,7 @@ begin
   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 @@ begin
     end;
   OutStream.Free;
   Project.Free;
-
 end;
 
 var
@@ -178,7 +177,7 @@ var
 
 begin
   InitOptions;
-  Writeln(stderr,'chmcmd, a CHM compiler. (c) 2010 Free Pascal core.');
+  Writeln(stderr,'chmcmd, a CHM compiler. (c) 2010-2019 Free Pascal core.');
   Writeln(Stderr);
   repeat
     c:=getlongopts('h',@theopts[1],optionindex);

packages/chm/src/chmfilewriter.pas

@@ -742,16 +742,19 @@ begin
 
    i:=pos('#',outstring);
    if i<>0 then begin
-     if i > 1 then
-       Anchor := outstring
-     else
-       Anchor := localname+outstring;
-     j := fAnchorList.IndexOf(Anchor);
-     if j < 0 then begin
-       fAnchorList.AddObject(Anchor,TFirstReference.Create(localname));
-       Anchor := '(new) '+Anchor;
-     end;
-     Error(CHMNote, 'Anchor found '+Anchor+' while scanning '+localname,1);
+     if i<>length(outstring) then // trims lone '#' at end of url.
+       begin
+         if i > 1 then
+           Anchor := outstring
+         else
+           Anchor := localname+outstring;
+         j := fAnchorList.IndexOf(Anchor);
+         if j < 0 then begin
+           fAnchorList.AddObject(Anchor,TFirstReference.Create(localname));
+           Anchor := '(new) '+Anchor;
+         end;
+         Error(CHMNote, 'Anchor found '+Anchor+' while scanning '+localname,1);
+       end;
      delete(outstring,i,length(outstring)-i+1);
    end;
 
@@ -759,6 +762,8 @@ begin
 
   outstring:=extractrelativepath(basepath,outstring);
   outstring:=StringReplace(outstring,'\','/',[rfReplaceAll]);
+  if outstring='' then
+    result:=false;
 end;
 
 function  TChmProject.FileInTotalList(const s:String):boolean;
@@ -808,13 +813,55 @@ begin
       filelist.add(fn);
 end;
 
+procedure checkattributesA(node:TDomNode;const localname: string; filelist :TStringList);
+// workaround for "a" tag that has href and src. If src exists, don't check href, this
+// avoids spurious warnings.
+var
+    fn  : String;
+    val : String;
+    found : boolean;
+begin
+  found:=false;
+  val := findattribute(node,'SRC');
+  if sanitizeurl(fbasepath,val,localpath,localname,fn) then
+      found:=true;
+  if not found then
+    begin
+      val := findattribute(node,'HREF');
+      if sanitizeurl(fbasepath,val,localpath,localname,fn) then
+        found:=true;
+    end;
+ if found and not FileInTotalList(uppercase(fn)) then
+      filelist.add(fn);
+end;
 
 function scantags(prnt:TDomNode; const localname: string; filelist:TStringlist):TDomNode;
-// Seach first matching tag in siblings
+
+var
+  att : ansistring;
+
+procedure AddAnchor(const s:string);
+var
+   i   : Integer;
+begin
+  i := fAnchorList.IndexOf(localname+'#'+s);
+  if i < 0 then begin
+    fAnchorList.Add(localname+'#'+s);
+    Error(ChmNote,'New Anchor with '+att+' '+s+' found while scanning '+localname,1);
+  end else if fAnchorList.Objects[i] = nil then
+    Error(chmwarning,'Duplicate anchor definitions with '+att+' '+s+' found while scanning '+localname,1)
+  else begin
+    fAnchorList.Objects[i].Free;
+    fAnchorList.Objects[i] := nil;
+    Error(ChmNote,'Anchor with '+att+' '+s+' defined while scanning '+localname,1);
+  end;
+end;
+
 var chld: TDomNode;
-    s,
-    att : ansistring;
-    i   : Integer;
+    s,attrval  : ansistring;
+    idfound : boolean;
+
+
 begin
   result:=nil;
   if assigned(prnt )  then
@@ -826,6 +873,11 @@ begin
           if (chld is TDomElement) then
             begin
               s:=uppercase(tdomelement(chld).tagname);
+              att := 'ID';
+              attrval := findattribute(chld, att);
+              idfound:=attrval  <> '' ;
+              if idfound then
+                addanchor(attrval);
               if s='LINK' then
                 begin
                   //printattributes(chld,'');
@@ -836,34 +888,21 @@ begin
                   //printattributes(chld,'');
                   checkattributes(chld,'SRC',localname,filelist);
                 end;
-             if s='IMG'then
+             if s='IMG' then
                begin
                   //printattributes(chld,'');
                   checkattributes(chld,'SRC',localname,filelist);
                end;
-             if s='A'then
+             if s='A' then
                begin
                   //printattributes(chld,'');
-                  checkattributes(chld,'HREF',localname,filelist);
-                  att := 'NAME';
-                  s := findattribute(chld, att);
-                  if s = '' then begin
-                     att := 'ID';
-                     s := findattribute(chld, att);
-                  end;
-                  if s <> '' then
+                  checkattributesA(chld,localname,filelist);
+                  if not idfound then
                     begin
-                      i := fAnchorList.IndexOf(localname+'#'+s);
-                      if i < 0 then begin
-                        fAnchorList.Add(localname+'#'+s);
-                        Error(ChmNote,'New Anchor with '+att+' '+s+' found while scanning '+localname,1);
-                      end else if fAnchorList.Objects[i] = nil then
-                        Error(chmwarning,'Duplicate anchor definitions with '+att+' '+s+' found while scanning '+localname,1)
-                      else begin
-                        fAnchorList.Objects[i].Free;
-                        fAnchorList.Objects[i] := nil;
-                        Error(ChmNote,'Anchor with '+att+' '+s+' defined while scanning '+localname,1);
-                      end;
+                      att := 'NAME';
+                      attrval := findattribute(chld, att);
+                      if attrval  <> '' then
+                       addanchor(attrval);
                     end;
                 end;
             end;
@@ -876,7 +915,7 @@ var
   localfilelist: TStringList;
   domdoc : THTMLDocument;
   i,j    : Integer;
-  fn,s   : string;
+  fn,reffn   : string;
   ext    : String;
   tmplst : Tstringlist;
   strrec : TStringIndex;
@@ -926,10 +965,9 @@ begin
                scantags(domdoc,extractfilename(fn),localfilelist);
                for i:=0 to localFilelist.count-1 do
                  begin
-                   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);
+                   reffn:=localfilelist[i];
+                   if not trypath(reffn) then  //  if not trypath(localpath+s) then
+                       Error(ChmWarning,'Found file '+reffn+' while scanning '+fn+', but couldn''t find it on disk',2);
                  end;
              except
                on e:EDomError do
@@ -952,15 +990,14 @@ begin
 
            for i:=0 to tmplst.Count-1 do
              begin
-               s:=tmplst[i];
-               if pos('url(''', tmplst[i])>0 then
+               reffn:=tmplst[i];
+               if pos('url(''', reffn)>0 then
                  begin
-                   delete(s,1,pos('url(''', tmplst[i])+4);
-                   s:=trim(copy(s,1,pos('''',s)-1));
-
-                   if not trypath(s) then
+                   delete(reffn,1,pos('url(''', reffn)+4);
+                   reffn:=trim(copy(reffn,1,pos('''',reffn)-1));
+                   if not trypath(reffn) then
 //                     if not trypath(localpath+s) then
-                       Error(ChmWarning,'Found file '+s+' while scanning '+fn+', but couldn''t find it on disk',2);
+                       Error(ChmWarning,'Found file '+reffn+' while scanning '+fn+', but couldn''t find it on disk',2);
                  end;
              end;
          finally
@@ -984,8 +1021,9 @@ procedure TChmProject.ScanSitemap(sitemap:TChmSiteMap;newfiles:TStrings;recursio
 
 procedure scanitems(it:TChmSiteMapItems);
 
-var i : integer;
+var i,j : integer;
     x : TChmSiteMapItem;
+    si  : TChmSiteMapSubItem;
     s : string;
     strrec : TStringIndex;
 
@@ -993,28 +1031,31 @@ begin
   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.
-        begin
-          if not FileInTotalList(uppercase(s)) then
-            begin
-              if fileexists(s) then
-                begin
-                  Error(chmnote,'Good url: '+s+'.',5);
-                  StrRec:=TStringIndex.Create;
-                  StrRec.TheString:=uppercase(s);
-                  StrRec.Strid    :=0;
-                  fTotalFileList.Add(StrRec);
-                  newfiles.add(s);
-                end
-              else
-                Error(chmnote,'duplicate url: '+s+'.',5);
-            end
-          else
-            Error(chmnote,'duplicate url: '+s+'.',5);
-        end
-      else
-       Error(chmnote,'Bad url: '+s+'.',5);
-
+      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
+                   if fileexists(s) then
+                     begin
+                       Error(chmnote,'Good url: '+s+'.',5);
+                       StrRec:=TStringIndex.Create;
+                       StrRec.TheString:=uppercase(s);
+                       StrRec.Strid    :=0;
+                       fTotalFileList.Add(StrRec);
+                       newfiles.add(s);
+                     end
+                   else
+                     Error(chmnote,'duplicate url: '+s+'.',5);
+                 end
+               else
+                 Error(chmnote,'duplicate url: '+s+'.',5);
+             end
+           else
+            Error(chmnote,'Bad url: '+s+'.',5);
+         end;
       if assigned(x.children) and (x.children.count>0) then
         scanitems(x.children);
     end;
@@ -1169,7 +1210,7 @@ var
 begin
   for i := 0 to fAnchorList.Count-1 do
     if fAnchorList.Objects[i] <> nil then
-      Error(chmerror,'Anchor '+fAnchorList[i]+' undefined; first use '+TFirstReference(fAnchorList.Objects[i]).Location);
+       Error(chmerror,'Anchor '+fAnchorList[i]+' undefined; first use '+TFirstReference(fAnchorList.Objects[i]).Location);
 end;
 
 procedure TChmProject.LoadSitemaps;
@@ -1188,7 +1229,6 @@ begin
            FreeAndNil(FToc);
            FToc:=TChmSiteMap.Create(sttoc);
            FToc.loadfromstream(FTocStream);
-           ftoc.savetofile('bla.something');
          except
           on e:exception do
             begin

packages/chm/src/chmreader.pas

@@ -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 @@ var
   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,12 @@ begin
     fTOPICSStream.ReadDWord;
     TopicTitleOffset := LEtoN(fTOPICSStream.ReadDWord);
     TopicURLTBLOffset := LEtoN(fTOPICSStream.ReadDWord);
+    {$ifdef binindex}
+    {$ifndef nonumber}
+    writeln('titleid:',TopicTitleOffset);
+    writeln('urlid  :',TopicURLTBLOffset);
+    {$endif}
+    {$endif}
     if TopicTitleOffset <> $FFFFFFFF then
       ATitle := ReadStringsEntry(TopicTitleOffset);
      //WriteLn('Got a title: ', ATitle);
@@ -1016,7 +1024,10 @@ begin
   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
   setlength(ws,n div sizeof(widechar));
   move(oldhead^,ws[1],n);
   for n:=1 to length(ws) do
@@ -1024,10 +1035,15 @@ begin
   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;
 
@@ -1045,76 +1061,48 @@ begin
       result:=nil;
 end;
 
-procedure createentry(Name:ansistring;CharIndex:integer;Topic,Title:ansistring);
-var litem : TChmSiteMapItem;
-    shortname : ansistring;
-    longpart  : ansistring;
-begin
- if charindex=0 then
-   begin
-     item:=sitemap.items.NewItem;
-     item.keyword:=Name;
-     item.local:=topic;
-     item.text:=title;
-   end
- else
-   begin
-     shortname:=copy(name,1,charindex-2);
-     longpart:=copy(name,charindex,length(name)-charindex+1);
-     if assigned(item) and (shortname=item.text) then
-       begin
-         litem:=item.children.newitem;
-         litem.local:=topic;
-         litem.keyword :=longpart; // recursively split this? No examples.
-         litem.text:=title;
-       end
-      else
-       begin
-         item:=sitemap.items.NewItem;
-         item.keyword:=shortname;
-         item.local:=topic;
-         item.text:=title;
-         litem:=item.children.newitem;
-         litem.keyword:=longpart;
-         litem.local:=topic;
-         litem.text :=Title; // recursively split this? No examples.
-       end;
-   end;
-end;
+var
+   parentitem:TChmSiteMapItems;
+   itemstack :TObjectList;
+   lookup  : TLookupDict;
+   curitemdepth : integer;
+   sitemap : TChmSiteMap;
 
-procedure createentryseealso(Name:ansistring;CharIndex:integer;seealso:ansistring);
-var litem : TChmSiteMapItem;
+function getitem(anentrydepth:integer):Tchmsitemapitems;
 begin
-     item:=sitemap.items.NewItem;
-     item.KeyWord:=name;
-     item.SeeAlso:=seealso;
+   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,8 +1113,41 @@ var hdr:PBTreeBlockHeader;
     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);
@@ -1135,17 +1156,21 @@ begin
   hdr^.IndexOfPrevBlock:=LEToN(hdr^.IndexOfPrevBlock);
   hdr^.IndexOfNextBlock:=LEToN(hdr^.IndexOfNextBlock);
 
+  {$ifdef binindex}
+  writeln('hdr:',hdr^.length);
+  {$endif}
   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 +1183,75 @@ begin
       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;
+      {$ifdef binindex}
+      writeln('depth:', curitemdepth, ' ' ,entrydepth);
+      {$endif}
+      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);
+            {$ifdef binindex}
+            writeln('bingo!', parentitem.parentname);
+            dumpstack;
+            {$endif}
+            item:=parentitem.newitem;
+            pushitem(entrydepth+1,item);
+          end;
+
+      curitemdepth:=entrydepth;
+      {$ifdef binindex}
+      writeln('lookup:', Name, ' = ', path,' = ',shortname);
+      {$endif}
+
+    (*  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 +1272,7 @@ begin
           {$ifdef binindex}
             writeln('seealso: ',seealsostr);
           {$endif}
-
+          item.AddSeeAlso(seealsostr);
         end
       else
         begin
@@ -1190,24 +1284,13 @@ begin
 
             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,15 +1298,16 @@ begin
       {$endif}
       inc(head,4); // zero based index (13 higher than last
     end;
-  ItemStack.Free;
 end;
 
 var TryTextual : boolean;
     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 +1321,12 @@ begin
      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 +1335,7 @@ begin
          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 +1351,7 @@ begin
       Result:=AbortAndTryTextual;
     end
   else Index.Free;
+  lookup.free;
 end;
 
 function TChmReader.GetTOCSitemap(ForceXML:boolean=false): TChmSiteMap;
@@ -1279,13 +1367,12 @@ function TChmReader.GetTOCSitemap(ForceXML:boolean=false): TChmSiteMap;
       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 +1811,7 @@ var
   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;

packages/chm/src/chmsitemap.pas

@@ -20,54 +20,104 @@
 }
 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;
     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,6 +130,7 @@ type
     FParentItem: TChmSiteMapItem;
     function GetCount: Integer;
     function GetItem(AIndex: Integer): TChmSiteMapItem;
+    function getparentname: String;
     procedure SetItem(AIndex: Integer; const AValue: TChmSiteMapItem);
   public
     constructor Create(AOwner: TChmSiteMap; AParentItem: TChmSiteMapItem);
@@ -95,6 +146,7 @@ type
     property ParentItem: TChmSiteMapItem read FParentItem;
     property Owner: TChmSiteMap read FOwner;
     property InternalData: Dword read FInternalData write FInternalData;
+    property ParentName : String read getparentname;
   end;
   
 
@@ -130,13 +182,17 @@ type
     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);
   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 @@ type
     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 @@ begin
   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,98 @@ procedure TChmSiteMap.FoundTag(ACaseInsensitiveTag, AActualTag: string);
       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);
-
-{  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;}
-
-  //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);
+   if TagName = 'UL' then begin
+     IncreaseULevel;
+   end
+   else if TagName = '/UL' then begin
+     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;
-
-     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
+   end
+   else begin // we are the properties of the object tag
+     if (smbtOBJECT in FSiteMapBodyTags) then
+       begin
+        if (FLevel > 0 ) 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');
-                //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;
+            if LowerCase(GetTagName(AActualTag)) = 'param' then begin
+              TagAttributeName := GetVal(AActualTag, 'name');
+              TagAttributeValue := GetVal(AActualTag, 'value');
+
+              // a hash reduces comparisons and casing, and generics make it easy.
+              if not FLoadDict.trygetvalue(uppercase(TagAttributeName),TagAttrName) then
+                 TagAttrName:=siteattr_none;
+
+              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
+               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 +414,22 @@ destructor TChmSiteMap.Destroy;
 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 +442,8 @@ begin
   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 +454,13 @@ procedure TChmSiteMap.LoadFromStream(AStream: TStream);
 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 +478,9 @@ begin
     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,44 +492,86 @@ var
      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+'">');
   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;
@@ -475,7 +601,7 @@ begin
     // both TOC and Index have font
     if Font <> '' then
       WriteParam('Font', Font);
-    Dec(Indent, 8);
+  Dec(Indent, 8);
   WriteString('</OBJECT>');
   
   // And now the items
@@ -501,19 +627,137 @@ begin
   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 +765,15 @@ begin
   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 +830,11 @@ begin
 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.

packages/chm/src/chmwriter.pas

@@ -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 @@ unit chmwriter;
 {$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 @@ Type
     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;
@@ -186,6 +187,7 @@ Type
     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 +1523,7 @@ begin
   FDefaultWindow:= '';
   FMergeFiles   :=TStringList.Create;
   FNrTopics     :=0;
+  FDictTopicsUrlInd    :=specialize TDictionary<string,integer>.Create;
 end;
 
 destructor TChmWriter.Destroy;
@@ -1543,7 +1546,7 @@ begin
   FAVLTopicdedupe.FreeAndClear;
   FAVLTopicdedupe.free;
   FWindows.Free;
-
+  FDictTopicsUrlInd.Free;
   inherited Destroy;
 end;
 
@@ -1664,6 +1667,7 @@ var
     TopicEntry: TTopicEntry;
 
 begin
+    ATitle :=StringReplace(Atitle, '&x27;', '', [rfReplaceAll]);
     anurl:=StringReplace(anurl, '\', '/', [rfReplaceAll]);
     if ATitle <> '' then
       TopicEntry.StringsOffset := AddString(ATitle)
@@ -1691,6 +1695,35 @@ begin
     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
+     {$ifdef binindex}
+       writeln('found:',result);
+     {$endif}
+   end
+   else
+    begin
+      result:=addtopic(atitle,anurl);
+      FDictTopicsUrlInd.add(anurl,result);
+    end;
 end;
 
 procedure TChmWriter.ScanSitemap(asitemap:TCHMSiteMap);
@@ -2039,32 +2072,64 @@ begin
   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
+     {$ifdef binindex}
+     write('!seealso');
+     {$endif}
+     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;
+          {$ifdef binindex}
+          writeln('---',sb.name,' ',sb.local);
+          {$endif}
+          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 +2223,36 @@ begin
   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;
-begin
-  if ParentItem.Children.Count = 0 Then
-    Begin
+    llItem : TChmSiteMapItem;
+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 +2273,7 @@ begin
   {$ifdef binindex}
     writeln('starting index');
   {$endif}
+  ASiteMap.sort(@indexitemcompare);
   IndexStream:=TMemoryStream.Create;
   indexstream.size:=sizeof(TBTreeHeader);
   IndexStream.position:=Sizeof(TBTreeHeader);
@@ -2251,7 +2321,7 @@ begin
       // 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 +2490,6 @@ begin
   PostAddStreamToArchive(AName, '/', AStream);
 end;
 
-
 procedure TChmWriter.AddContext(AContext: DWord; ATopic: String);
 var
   Offset: DWord;
@@ -2448,7 +2517,6 @@ begin
 end;
 
 procedure TChmWriter.Setwindows(AWindowList: TObjectList);
-
 var i : integer;
     x : TCHMWindow;
 begin

utils/fpdoc/dw_htmlchm.inc

@@ -192,12 +192,12 @@ begin
         // 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 @@ begin
         // 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 @@ begin
         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 @@ begin
         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 @@ begin
             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 @@ begin
           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 @@ begin
         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 @@ begin
         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 @@ begin
         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 @@ begin
             // 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 @@ begin
         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
       {