* initial #windows, defaultwindow support

 * initially working .hhp support in chmcmd
 * index and toc are not always named default.hh[k/c] anymore, but use the names in the project xml if specified.
 * callback to allow basic output for filewriter/chmcmd

git-svn-id: trunk@15550 -

packages/chm/src/chmcmd.lpr

@@ -23,7 +23,7 @@ program chmcmd;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, chmfilewriter;
+  Classes, Sysutils, chmfilewriter;
 
 Procedure Usage;
 
@@ -32,24 +32,40 @@ begin
   Halt(1);
 end;
 
+procedure OnError (Project: TChmProject;errorkind:TChmProjectErrorKind;msg:String);
+begin
+  writeln(ChmErrorKindText[errorkind],': ',msg);
+end;
 
 var
   OutStream: TFileStream;
   Project: TChmProject;
+  name   : string;
+  xmlname: string;
+  ishhp  : boolean;
 
 begin
-  if (Paramcount=1) and (ParamStr(1)<>'-h') and (ParamStr(1)<>'-?') then 
+  if (Paramcount=1) and (ParamStr(1)<>'-h') and (ParamStr(1)<>'-?') then
     begin
-    Project := TChmProject.Create;
-    Project.LoadFromFile(ParamStr(1));
-    OutStream := TFileStream.Create(Project.OutputFileName, fmCreate, fmOpenWrite);
-    Project.WriteChm(OutStream);
-    OutStream.Free;
-    Project.Free;
+      name:=paramstr(1);
+      ishhp:=uppercase(extractfileext(name))='.HHP';
+      Project := TChmProject.Create;
+      if ishhp then
+        begin
+          xmlname:=changefileext(name,'.hhp.xml');
+          Project.LoadFromHHP(name,false) ;          // we need a param for this second param later
+          Project.SaveToFile(xmlname);
+        end
+      else
+        Project.LoadFromFile(name);
+      OutStream := TFileStream.Create(Project.OutputFileName, fmCreate, fmOpenWrite);
+      Project.WriteChm(OutStream);
+      OutStream.Free;
+      Project.Free;
     end
   else
     begin
-    Usage;
-    end; 
+      Usage;
+    end;
 end.
 

packages/chm/src/chmfilewriter.pas

@@ -25,12 +25,15 @@ unit chmfilewriter;
 interface
 
 uses
-  Classes, SysUtils, chmwriter, inifiles, contnrs;
+  Classes, SysUtils, chmwriter, inifiles, contnrs,
+  {for html scanning } dom,SAX_HTML,dom_html;
 
 type
   TChmProject = class;
+  TChmProjectErrorKind = (chmerror,chmwarning,chmhint,chmnote);
 
   TChmProgressCB = procedure (Project: TChmProject; CurrentFile: String) of object;
+  TChmErrorCB    = procedure (Project: TChmProject;errorkind:TChmProjectErrorKind;msg:String);
 
   { TChmProject }
 
@@ -46,16 +49,19 @@ type
     FMakeSearchable: Boolean;
     FFileName: String;
     FOnProgress: TChmProgressCB;
+    FOnError   : TChmErrorCB;
     FOutputFileName: String;
     FTableOfContentsFileName: String;
     FTitle: String;
     FWindows : TObjectList;
     FMergeFiles : TStringlist;
     fDefaultWindow : string;
+    fScanHtmlContents  : Boolean;
   protected
     function GetData(const DataName: String; out PathInChm: String; out FileName: String; var Stream: TStream): Boolean;
     procedure LastFileAdded(Sender: TObject);
     procedure readIniOptions(keyvaluepairs:tstringlist);
+    procedure ScanHtml;
   public
     constructor Create; virtual;
     destructor Destroy; override;
@@ -65,6 +71,7 @@ type
     procedure WriteChm(AOutStream: TStream); virtual;
     function ProjectDir: String;
     procedure AddFileWithContext(contextid:integer;filename:ansistring;contextname:ansistring='');
+    procedure Error(errorkind:TChmProjectErrorKind;msg:String);
     // though stored in the project file, it is only there for the program that uses the unit
     // since we actually write to a stream
     property OutputFileName: String read FOutputFileName write FOutputFileName;
@@ -82,7 +89,9 @@ type
     property Windows :TObjectList read FWindows write FWindows;
     property MergeFiles :TStringlist read FMergeFiles write FMergefiles;
     property OnProgress: TChmProgressCB read FOnProgress write FOnProgress;
+    property OnError   : TChmErrorCB read FOnError write FOnError;
     property DefaultWindow : String read FDefaultWindow write FDefaultWindow;
+    property ScanHtmlContents  : Boolean read fScanHtmlContents write fScanHtmlContents;
   end;
 
   TChmContextNode = Class
@@ -91,6 +100,11 @@ type
                      ContextName   : AnsiString;
                     End;
 
+
+
+Const
+  ChmErrorKindText : array[TCHMProjectErrorKind] of string = ('Error','Warning','Hint','Note');
+
 implementation
 
 uses XmlCfg, chmsitemap, CHMTypes;
@@ -162,6 +176,7 @@ begin
   FFiles := TStringList.Create;
   FWindows:=TObjectList.Create(True);
   FMergeFiles:=TStringlist.Create;
+  ScanHtmlContents:=False;
 end;
 
 destructor TChmProject.Destroy;
@@ -334,6 +349,8 @@ begin
   OutputFileName := Cfg.GetValue('Settings/OutputFileName/Value', '');
   DefaultFont  := Cfg.GetValue('Settings/DefaultFont/Value', '');
   DefaultWindow:= Cfg.GetValue('Settings/DefaultWindow/Value', '');
+  ScanHtmlContents:=  Cfg.GetValue('Settings/ScanHtmlContents/Value', False);
+
   Cfg.Free;
 end;
 
@@ -538,6 +555,7 @@ begin
   secs.free;
   strs.free;
   fini.free;
+  ScanHtmlContents:=true;
 end;
 
 procedure TChmProject.AddFileWithContext(contextid:integer;filename:ansistring;contextname:ansistring='');
@@ -598,10 +616,10 @@ begin
     Cfg.SetValue('MergeFiles/FileName'+IntToStr(I)+'/value',FMergeFiles[i]);
 
   // delete legacy keys.
-  Cfg.SetValue('Files/IndexFile/Value','');
-  Cfg.SetValue('Files/TOCFile/Value', '');
-  Cfg.SetValue('Files/MakeBinaryTOC/Value','');
-  Cfg.SetValue('Files/MakeBinaryIndex/Value','');
+  Cfg.DeleteValue('Files/IndexFile/Value');
+  Cfg.DeleteValue('Files/TOCFile/Value');
+  Cfg.DeleteValue('Files/MakeBinaryTOC/Value');
+  Cfg.DeleteValue('Files/MakeBinaryIndex/Value');
   Cfg.SetValue('Settings/IndexFile/Value', IndexFileName);
   Cfg.SetValue('Settings/TOCFile/Value', TableOfContentsFileName);
   Cfg.SetValue('Settings/MakeBinaryTOC/Value',MakeBinaryTOC);
@@ -615,6 +633,7 @@ begin
   Cfg.SetValue('Settings/DefaultFont/Value', DefaultFont);
 
   Cfg.SetValue('Settings/DefaultWindow/Value', DefaultWindow);
+  Cfg.SetValue('Settings/ScanHtmlContents/Value', ScanHtmlContents);
 
 
   Cfg.Flush;
@@ -626,6 +645,108 @@ begin
   Result := ExtractFilePath(FileName);
 end;
 
+procedure TChmProject.Error(errorkind:TChmProjectErrorKind;msg:String);
+begin
+  if assigned(OnError) then
+    OnError(self,errorkind,msg);
+end;
+
+procedure TChmProject.ScanHtml;
+
+procedure checkattributes(node:TDomNode;attributename:string;filelist :TStringList);
+var
+    Attributes: TDOMNamedNodeMap;
+    atnode    : TDomNode;
+    fn        : String;
+begin
+  if assigned(node) then
+    begin
+      Attributes:=node.Attributes;
+      if assigned(attributes) then
+         begin
+           atnode :=attributes.GetNamedItem(attributename);
+           if assigned(atnode) then
+             begin
+               fn:=atnode.nodevalue;
+               if (fn<>'') then
+                  filelist.add(fn);
+             end;
+         end;
+    end;
+end;
+
+
+function scantags(prnt:TDomNode;filelist:TStringlist):TDomNode;
+// Seach first matching tag in siblings
+var chld: TDomNode;
+begin
+  result:=nil;
+  if assigned(prnt )  then
+    begin
+      chld:=prnt.firstchild;
+      while assigned(chld) do
+        begin
+          scantags(chld,filelist);  // depth first.
+          if (chld is TDomElement) then
+            begin
+             // writeln(tdomelement(chld).tagname,' ',chld.classname	);
+              if tdomelement(chld).tagname='link'then
+                begin
+                  //printattributes(chld,'');
+                  checkattributes(chld,'href',filelist);
+                end;
+             if tdomelement(chld).tagname='img'then
+               begin
+                  //printattributes(chld,'');
+                  checkattributes(chld,'src',filelist);
+                end;
+
+            end;
+          chld:=chld.nextsibling;
+        end;
+    end;
+end;
+
+var
+  filelist, localfilelist: TStringList;
+  domdoc : THTMLDocument;
+  i,j  : Integer;
+  fn,s  : string;
+begin
+ filelist:= TStringList.create;
+ localfilelist:= TStringList.create;
+
+ for j:=0 to Files.count-1 do
+   begin
+     fn:=files[j];
+     writeln(fn);
+     localfilelist.clear;
+     if fileexists(fn) then
+       begin
+         ReadHtmlFile(domdoc,fn);
+         scantags(domdoc,localfilelist);
+         for i:=0 to localFilelist.count-1 do
+           begin
+             s:=localfilelist[i];
+             if fileexists(s) then  // correct for relative path .html file?
+               begin
+                 filelist.add(s);
+                 Error(ChmNote,'Found file '+s+' while scanning '+fn);
+               end
+             else
+               begin
+                 Error(ChmWarning,'Found file '+s+' while scanning '+fn+', but couldn''t find it on disk');
+               end
+           end;
+         domdoc.free;
+       end;
+   end;
+ files.addstrings(filelist);
+ filelist.free;
+ localfilelist.free;
+end;
+
+
 procedure TChmProject.WriteChm(AOutStream: TStream);
 var
   Writer     : TChmWriter;
@@ -653,14 +774,22 @@ begin
   Writer.FullTextSearch := MakeSearchable;
   Writer.HasBinaryTOC := MakeBinaryTOC;
   Writer.HasBinaryIndex := MakeBinaryIndex;
+  Writer.IndexName := IndexFileName;
+  Writer.TocName   := TableOfContentsFileName;
 
   for i:=0 to files.count-1 do
     begin
       nd:=TChmContextNode(files.objects[i]);
+      if not fileexists(files[i]) then
+         Error(chmWarning,'File '+Files[i]+' does not exist');
       if assigned(nd) and (nd.contextnumber<>0) then
         Writer.AddContext(nd.ContextNumber,files[i]);
     end;
+  if FWIndows.Count>0 then
+    Writer.Windows:=FWIndows;
 
+  If ScanHtmlContents Then
+    ScanHtml;                 // Since this is slowing we opt to skip this step, and only do this on html load.
   // and write!
   Writer.Execute;
 

packages/chm/src/chmreader.pas

@@ -28,18 +28,18 @@ unit chmreader;
 interface
 
 uses
-  Classes, SysUtils, chmbase, paslzx, chmFIftiMain, chmsitemap;
-  
+  Classes, SysUtils, Contnrs, chmbase, paslzx, chmFIftiMain, chmsitemap;
+
 type
 
   TLZXResetTableArr = array of QWord;
-  
+
   PContextItem = ^TContextItem;
   TContextItem = record
     Context: THelpContext;
     Url: String;
   end;
-  
+
   TContextList = class(TList)
   public
     procedure AddContext(Context: THelpContext; Url: String);
@@ -89,7 +89,7 @@ type
     function GetObject(Name: String): TMemoryStream; virtual; // YOU must Free the stream
     property CachedEntry: TPMGListChunkEntry read fCachedEntry;
   end;
-  
+
   { TChmReader }
 
   TChmReader = class(TITSFReader)
@@ -105,12 +105,16 @@ type
     fURLTBLStream,
     fStringsStream: TMemoryStream;
     fLocaleID: DWord;
+    fWindows      : TObjectList;
+    fDefaultWindow: String;
   private
     FSearchReader: TChmSearchReader;
     procedure ReadCommonData;
     function  ReadStringsEntry(APosition: DWord): String;
+    function  ReadStringsEntryFromStream ( strm:TStream ) : String;
     function  ReadURLSTR(APosition: DWord): String;
     function  CheckCommonStreams: Boolean;
+    procedure ReadWindows(mem:TMemoryStream);
   public
     constructor Create(AStream: TStream; FreeStreamOnDestroy: Boolean); override;
     destructor Destroy; override;
@@ -128,6 +132,8 @@ type
     property LocaleID: dword read fLocaleID;
     property SearchReader: TChmSearchReader read FSearchReader write FSearchReader;
     property contextlist : tcontextlist read fcontextlist;
+    property Windows : TObjectlist read fwindows;
+    property DefaultWindow : string read fdefaultwindow;
   end;
 
   { TChmFileList }
@@ -157,7 +163,7 @@ type
     property FileName[Index: Integer]: String read GetFileName;
     property OnOpenNewFile: TChmFileOpenEvent read fOnOpenNewFile write SetOnOpenNewFile;
   end;
-  
+
 //ErrorCodes
 const
   ERR_NO_ERR = 0;
@@ -165,7 +171,7 @@ const
   ERR_NOT_SUPPORTED_VERSION = 2;
   ERR_NOT_VALID_FILE = 3;
   ERR_UNKNOWN_ERROR = 10;
-  
+
   function ChmErrorToStr(Error: Integer): String;
 
 implementation
@@ -209,12 +215,12 @@ begin
   fITSFHeader.TimeStamp := BEtoN(fITSFHeader.TimeStamp);//bigendian
   fITSFHeader.LanguageID := LEtoN(fITSFHeader.LanguageID);
   {$ENDIF}
-
+ 
   if fITSFHeader.Version < 4 then
    fStream.Seek(SizeOf(TGuid)*2, soCurrent);
   
   if not IsValidFile then Exit;
-  
+
   ReadHeaderEntries;
 end;
 
@@ -416,6 +422,7 @@ procedure TChmReader.ReadCommonData;
          fDefaultPage := '/'+ReadString(fStrings);
        end;
      end;
+     ReadWindows(FWindows);
    end;
    procedure ReadContextIds;
    var
@@ -447,7 +454,7 @@ begin
    ReadFromSystem;
    ReadFromWindows;
    ReadContextIds;
-   {$IFDEF CHM_DEBUG}   
+   {$IFDEF CHM_DEBUG}
    WriteLn('TOC=',fTocfile);
    WriteLn('DefaultPage=',fDefaultPage);
    {$ENDIF}
@@ -466,6 +473,13 @@ begin
   end;
 end;
 
+function TChmReader.ReadStringsEntryFromStream ( strm:TStream ) : String;
+var APosition : DWord;
+begin
+  APosition:=LEtoN(strm.ReadDWord);
+  result:=ReadStringsEntry(APosition);
+end;
+
 function TChmReader.ReadURLSTR ( APosition: DWord ) : String;
 var
   URLStrURLOffset: DWord;
@@ -497,6 +511,74 @@ begin
             and (fURLTBLStream <> nil);
 end;
 
+procedure TChmReader.ReadWindows(mem:TMemoryStream);
+
+var
+  i,cnt,
+  version   : integer;
+  x         : TChmWindow;
+begin
+ fWindows.Clear;
+ mem.Position:=0;
+ cnt  := LEtoN(mem.ReadDWord);
+ version  := LEtoN(mem.ReadDWord);
+ while (cnt>0) do
+   begin
+     x:=TChmWindow.Create;
+     version            := LEtoN(mem.ReadDWord);                        //  0 size of entry.
+     mem.readDWord;                                                     //  4 unknown (bool Unicodestrings?)
+     x.window_type      :=ReadStringsEntryFromStream(mem);              //  8 Arg 0, name of window
+     x.flags            := TValidWindowFields(LEtoN(mem.ReadDWord));    //  C valid fields
+     x.nav_style        := LEtoN(mem.ReadDWord);                        // 10 arg 10 navigation pane style
+     x.title_bar_text   :=ReadStringsEntryFromStream(mem);              // 14 Arg 1,  title bar text
+     x.styleflags       := LEtoN(mem.ReadDWord);                        // 18 Arg 14, style flags
+     x.xtdstyleflags    := LEtoN(mem.ReadDWord);                        // 1C Arg 15, xtd style flags
+     x.left             := LEtoN(mem.ReadDWord);                        // 20 Arg 13, rect.left
+     x.right            := LEtoN(mem.ReadDWord);                        // 24 Arg 13, rect.top
+     x.top              := LEtoN(mem.ReadDWord);                        // 28 Arg 13, rect.right
+     x.bottom           := LEtoN(mem.ReadDWord);                        // 2C Arg 13, rect.bottom
+     x.window_show_state:= LEtoN(mem.ReadDWord);                        // 30 Arg 16, window show state
+     mem.readdword;                                                     // 34  -    , HWND hwndhelp                OUT: window handle"
+     mem.readdword;                                                     // 38  -    , HWND hwndcaller              OUT: who called this window"
+     mem.readdword;                                                     // 3C  -    , HH_INFO_TYPE paINFO_TYPES    IN: Pointer to an array of Information Types"
+     mem.readdword;                                                     // 40  -    , HWND hwndtoolbar             OUT: toolbar window in tri-pane window"
+     mem.readdword;                                                     // 44  -    , HWND hwndnavigation          OUT: navigation window in tri-pane window"
+     mem.readdword;                                                     // 48  -    , HWND hwndhtml                OUT: window displaying HTML in tri-pane window"
+     x.navpanewidth     := LEtoN(mem.ReadDWord);                        // 4C Arg 11, width of nav pane
+     mem.readdword;                                                     // 50  -    , rect.left,   OUT:Specifies the coordinates of the Topic pane
+     mem.readdword;                                                     // 54  -    , rect.top ,   OUT:Specifies the coordinates of the Topic pane
+     mem.readdword;                                                     // 58  -    , rect.right,  OUT:Specifies the coordinates of the Topic pane
+     mem.readdword;                                                     // 5C  -    , rect.bottom, OUT:Specifies the coordinates of the Topic pane
+     x.toc_file         :=ReadStringsEntryFromStream(mem);              // 60 Arg 2,  toc file
+     x.index_file       :=ReadStringsEntryFromStream(mem);              // 64 Arg 3,  index file
+     x.default_file     :=ReadStringsEntryFromStream(mem);              // 68 Arg 4,  default file
+     x.home_button_file :=ReadStringsEntryFromStream(mem);              // 6c Arg 5,  home button file.
+     x.buttons          := LEtoN(mem.ReadDWord);                        // 70 arg 12,
+     x.navpane_initially_closed    := LEtoN(mem.ReadDWord);             // 74 arg 17
+     x.navpane_default  := LEtoN(mem.ReadDWord);                        // 78 arg 18,
+     x.navpane_location := LEtoN(mem.ReadDWord);                        // 7C arg 19,
+     x.wm_notify_id     := LEtoN(mem.ReadDWord);                        // 80 arg 20,
+     for i:=0 to 4 do
+       mem.ReadDWord;                                                   // 84  -      byte[20] unknown -  "BYTE tabOrder[HH_MAX_TABS + 1]; // IN/OUT: tab order: Contents, Index, Search, History, Favorites, Reserved 1-5, Custom tabs"
+     mem.ReadDWord;                                                     // 94  -      int cHistory; // IN/OUT: number of history items to keep (default is 30)
+     x.jumpbutton_1_text:=ReadStringsEntryFromStream(mem);              // 9C Arg 7,  The text of the Jump 1 button.
+     x.jumpbutton_2_text:=ReadStringsEntryFromStream(mem);              // A0 Arg 9,  The text of the Jump 2 button.
+     x.jumpbutton_1_file:=ReadStringsEntryFromStream(mem);              // A4 Arg 6,  The file shown for Jump 1 button.
+     x.jumpbutton_2_file:=ReadStringsEntryFromStream(mem);              // A8 Arg 8,  The file shown for Jump 1 button.
+     for i:=0 to 3 do
+       mem.ReadDWord;
+     dec(version,188);                                              // 1.1 specific onesf
+     while (version>=4) do
+       begin
+         mem.readdword;
+         dec(version,4);
+       end;
+
+     fWindows.Add(x);
+     dec(cnt);
+   end;
+end;
+
 constructor TChmReader.Create(AStream: TStream; FreeStreamOnDestroy: Boolean);
 begin
   inherited Create(AStream, FreeStreamOnDestroy);
@@ -504,11 +586,14 @@ begin
 
   fContextList := TContextList.Create;
   ReadCommonData;
+  fWindows      := TObjectlist.Create(True);
+  fDefaultWindow:='';
 end;
 
 destructor TChmReader.Destroy;
 begin
-  fContextList.Free;
+  FreeAndNil(fContextList);
+  FreeAndNil(FWindows);
   FreeAndNil(FSearchReader);
   FreeAndNil(fTOPICSStream);
   FreeAndNil(fURLSTRStream);
@@ -600,7 +685,7 @@ begin
 
   buf[NameLength] := #0;
   PMGIEntry.Name := buf;
-  
+
   PMGIEntry.ListingChunk := GetCompressedInteger(Stream);
   if NameLength = 0 then Exit; // failed GetCompressedInteger sanity check
   Result := True;
@@ -717,7 +802,7 @@ var
     OldPosn := ChunkStream.Position;
     Posn := ChunkStream.Size-SizeOf(Word);
     ChunkStream.Position := Posn;
-    
+
     ItemCount := LEToN(ChunkStream.ReadWord);
     //WriteLn('Max ITems for next block = ', ItemCount-1);
     QuickRefCount := ItemCount  div (1 + (1 shl fDirectoryHeader.Density));
@@ -745,10 +830,10 @@ var
 var
   PMGLChunk: TPMGListChunk;
   PMGIChunk: TPMGIIndexChunk;
-  //ChunkStream: TMemoryStream; declared above  
+  //ChunkStream: TMemoryStream; declared above
   Entry: TPMGListChunkEntry;
   NextIndex: Integer;
-  EntryName: String;  
+  EntryName: String;
   CRes: Integer;
   I: Integer;
 begin
@@ -764,10 +849,10 @@ begin
   ChunkStream := TMemoryStream.Create;
 
   try
-  
+
   NextIndex := fDirectoryHeader.IndexOfRootChunk;
   if NextIndex < 0 then NextIndex := 0; // no PMGI chunks
-  
+
   while NextIndex > -1  do begin
     GetDirectoryChunk(NextIndex, ChunkStream);
     NextIndex := -1;
@@ -783,7 +868,7 @@ begin
         end;
       ctPMGI: // we must follow the PMGI tree until we reach a PMGL block
         begin
-          LookupPMGIchunk(ChunkStream, PMGIChunk);          
+          LookupPMGIchunk(ChunkStream, PMGIChunk);
 
           //QuickRefIndex[0] := ChunkStream.Position;
 
@@ -794,13 +879,13 @@ begin
             if ChunkStream.Position >= ChunkStream.Size - PMGIChunk.UnusedSpace then break;
             CRes := ChmCompareText(Name, EntryName);
             if CRes = 0 then begin
-              // no more need of this block. onto the next!              
+              // no more need of this block. onto the next!
               NextIndex := GetCompressedInteger(ChunkStream);
               Break;
             end;
             if  CRes < 0 then begin
               if I = 0 then Break; // File doesn't exist
-              // file is in previous entry              
+              // file is in previous entry
               Break;
             end;
             NextIndex := GetCompressedInteger(ChunkStream);
@@ -813,7 +898,7 @@ begin
           QuickRefIndex[0] := ChunkStream.Position;
           I := 0;
           while ChunkStream.Position <= ChunkStream.Size - PMGLChunk.UnusedSpace do begin
-            // we consume the entry by reading it            
+            // we consume the entry by reading it
             Entry.Name := ReadString;
             if Entry.Name = '' then break;
             if ChunkStream.Position >= ChunkStream.Size - PMGLChunk.UnusedSpace then break;
@@ -825,7 +910,7 @@ begin
             CRes := ChmCompareText(Name, Entry.Name);
             if CRes = 0 then begin
               fCachedEntry := Entry;
-              Result := Entry.DecompressedLength;              
+              Result := Entry.DecompressedLength;
               Break;
             end;
             Inc(I);
@@ -944,7 +1029,7 @@ function TChmReader.GetIndexSitemap(ForceXML:boolean=false): TChmSiteMap;
 var Index   : TMemoryStream;
     sitemap : TChmSiteMap;
     Item    : TChmSiteMapItem;
-    
+
 function  AbortAndTryTextual:tchmsitemap;
 
 begin
@@ -995,7 +1080,7 @@ begin
          litem.local:=topic;
          litem.text :=Title; // recursively split this? No examples.
        end;
-   end;  
+   end;
 end;
 
 procedure parselistingblock(p:pbyte);
@@ -1021,7 +1106,7 @@ begin
 
   tail:=p+(2048-hdr^.length);
   head:=p+sizeof(TBtreeBlockHeader);
-  
+
   {$ifdef binindex}
   writeln('previndex  : ',hdr^.IndexOfPrevBlock);
   writeln('nextindex  : ',hdr^.IndexOfNextBlock);
@@ -1101,12 +1186,12 @@ begin
      Exit;
    end;
    SiteMap:=TChmSitemap.Create(StIndex);
-   Item   :=Nil;  // cached last created item, in case we need to make 
+   Item   :=Nil;  // cached last created item, in case we need to make
                   // a child.
    TryTextual:=True;
    BHdr.LastLstBlock:=0;
    if LoadBtreeHeader(index,BHdr) and (BHdr.LastLstBlock>0) Then
-    begin 
+    begin
        if BHdr.BlockSize=defblocksize then
          begin
            for i:=0 to BHdr.lastlstblock do
@@ -1118,8 +1203,8 @@ begin
                 end;
              end;
             trytextual:=false;
-            result:=sitemap; 
-          end;   
+            result:=sitemap;
+          end;
     end;
   if trytextual then
     begin
@@ -1239,7 +1324,7 @@ begin
     //WriteLn('Failed to get ::DataSpace/NameList!');
     exit;
   end;
-  
+
   Stream.Position := 2;
   EntryCount := LEtoN(Stream.ReadWord);
   for X := 0 to EntryCount -1 do begin
@@ -1355,7 +1440,7 @@ begin
         ReadCount := ResetTable[X+1] - ResetTable[X];
 
       BlockWriteLength := BlockSize;
-      
+
       if FirstBlock = LastBlock then begin
         WriteCount := BlockLength;
       end
@@ -1381,7 +1466,7 @@ begin
         LZXteardown(LZXState);
         Exit;
       end;
-      
+
       // if the next block is an even numbered block we have to reset the decompressor state
       if (X < LastBlock) and (X and 1 = 1) then LZXreset(LZXState);
 
@@ -1501,7 +1586,7 @@ end;
 function TChmFileList.CheckOpenFile(AFileName: String): Boolean;
 var
   X: Integer;
-  
+
 begin
   Result := False;
   for X := 0 to Count-1 do begin

packages/chm/src/chmtypes.pas

@@ -91,6 +91,22 @@ type
 
   end;
 
+  TValidWindowFieldsEnum = (valid_Unknown1 {:=1},
+                            valid_Navigation_pane_style {:= 2},
+                            valid_Window_style_flags {:= 4},
+                            valid_Window_extended_style_flags {:= 8},
+                            valid_Initial_window_position    {:= $10},
+                            valid_Navigation_pane_width {:= $20},
+                            valid_Window_show_state {:= $40},
+                            valid_Info_types {:= $80},
+                            valid_Buttons {:= $100},
+                            valid_Navigation_Pane_initially_closed_state {:= $200},
+                            valid_Tab_position {:= $400},
+                            valid_Tab_order {:= $800},
+                            valid_History_count{ := $1000},
+                            valid_Default_Pane {:= $2000});
+
+  TValidWindowFields     = Set Of TValidWindowFieldsEnum;
   TCHMWindow = Class
                 window_type,
                 Title_bar_text,
@@ -116,10 +132,13 @@ type
                 navpane_default,
                 navpane_location,
                 wm_notify_id : integer;
+                flags : TValidWindowFields; // bitset that keeps track of which fields are filled.
+                                            // of certain fields. Needs to be inserted into #windows stream
                 Constructor create(s:string='');
                 procedure load_from_ini(txt:string);
                 procedure savetoxml(cfg:TXMLConfig;key:string);
                 procedure loadfromxml(cfg:TXMLConfig;key:string);
+                procedure assign(obj : TCHMWindow);
                 end;
 
 
@@ -446,11 +465,17 @@ begin
  i:=ind+1; // skip ,
 end;
 
-function getnextint(const txt:string;var ind: integer;len:integer):integer;
+function getnextint(const txt:string;var ind: integer;len:integer;var flags : TValidWindowFields;x:TValidWindowFieldsEnum):integer;
 
 var s : string;
+    i:integer;
 begin
+
+  i:=ind;
   s:=getnext(txt,ind,len);
+  // set a flag if the field was empty (,,)
+  if (ind=(i+1)) and (x<>valid_unknown1) then
+    include(flags,x);
   result:=strtointdef(s,0);  // I think this does C style hex, if not fixup here.
 end;
 
@@ -460,6 +485,7 @@ var ind,len,
     arr     : array[0..3] of integer;
     s2      : string;
 begin
+  flags:=[];
   j:=pos('=',txt);
   if j>0 then
     txt[j]:=',';
@@ -475,15 +501,17 @@ begin
   Jumpbutton_2_File :=getnext(txt,ind,len);
   Jumpbutton_2_Text :=getnext(txt,ind,len);
 
-  nav_style         :=getnextint(txt,ind,len);
-  navpanewidth      :=getnextint(txt,ind,len);
-  buttons           :=getnextint(txt,ind,len);
+  nav_style         :=getnextint(txt,ind,len,flags,valid_navigation_pane_style);
+  navpanewidth      :=getnextint(txt,ind,len,flags,valid_navigation_pane_width);
+  buttons           :=getnextint(txt,ind,len,flags,valid_buttons);
   k:=0;
   repeat
    s2:=getnext(txt,ind,len);
    if (length(s2)>0) and (s2[1]='[') then delete(s2,1,1);
    j:=pos(']',s2);
    if j>0 then delete(s2,j,1);
+   if length(trim(s2))>0 then
+     include(flags,valid_tab_position);
    arr[k]:=strtointdef(s2,0);
    inc(k);
   until (j<>0) or (ind>len);
@@ -491,13 +519,13 @@ begin
   top   :=arr[1];
   right :=arr[2];
   bottom:=arr[3];
-  styleflags               :=getnextint(txt,ind,len);
-  xtdstyleflags            :=getnextint(txt,ind,len);
-  window_show_state        :=getnextint(txt,ind,len);
-  navpane_initially_closed :=getnextint(txt,ind,len);
-  navpane_default          :=getnextint(txt,ind,len);
-  navpane_location         :=getnextint(txt,ind,len);
-  wm_notify_id             :=getnextint(txt,ind,len);
+  styleflags               :=getnextint(txt,ind,len,flags,valid_buttons);
+  xtdstyleflags            :=getnextint(txt,ind,len,flags,valid_window_style_flags);
+  window_show_state        :=getnextint(txt,ind,len,flags,valid_window_extended_style_flags);
+  navpane_initially_closed :=getnextint(txt,ind,len,flags,valid_navigation_pane_initially_closed_state);
+  navpane_default          :=getnextint(txt,ind,len,flags,valid_default_pane);
+  navpane_location         :=getnextint(txt,ind,len,flags,valid_tab_position);
+  wm_notify_id             :=getnextint(txt,ind,len,flags,valid_unknown1);
 end;
 
 procedure TCHMWindow.savetoxml(cfg:TXMLConfig;key:string);
@@ -534,7 +562,7 @@ begin
   window_type           :=cfg.getvalue(key+'window_type','');
   Title_bar_text        :=cfg.getvalue(key+'title_bar_text','');
   Toc_file              :=cfg.getvalue(key+'toc_file','');
-  Index_file              :=cfg.getvalue(key+'index_file','');
+  Index_file            :=cfg.getvalue(key+'index_file','');
   Default_File          :=cfg.getvalue(key+'default_file','');
   Home_button_file      :=cfg.getvalue(key+'home_button_file','');
   Jumpbutton_1_File     :=cfg.getvalue(key+'jumpbutton_1_file','');
@@ -564,4 +592,34 @@ begin
    load_from_ini(s);
 end;
 
+
+procedure TCHMWindow.assign(obj : TCHMWindow);
+
+begin
+  window_type      :=obj.window_type;
+  Title_bar_text   :=obj.Title_bar_text;
+  Toc_file         :=obj.Toc_file;
+  Index_file       :=obj.Index_file;
+  Default_File     :=obj.Default_File;
+  Home_button_file :=obj.Home_button_file;
+  Jumpbutton_1_File:=obj.Jumpbutton_1_File;
+  Jumpbutton_1_Text:=obj.Jumpbutton_1_Text;
+  Jumpbutton_2_File:=obj.Jumpbutton_2_File;
+  Jumpbutton_2_Text:=obj.Jumpbutton_2_Text;
+  nav_style        :=obj.nav_style;
+  navpanewidth     :=obj.navpanewidth;
+  buttons          :=obj.buttons;
+  left             :=obj.left;
+  top              :=obj.top;
+  right            :=obj.right;
+  bottom           :=obj.bottom;
+  styleflags       :=obj.styleflags;
+  xtdstyleflags    :=obj.xtdstyleflags;
+  window_show_state:=obj.window_show_state;
+  navpane_initially_closed :=obj.navpane_initially_closed;
+  navpane_default  :=obj.navpane_default;
+  navpane_location :=obj.navpane_location;
+  wm_notify_id     :=obj.wm_notify_id;
+end;
+
 end.

packages/chm/src/chmwriter.pas

@@ -23,10 +23,13 @@ unit chmwriter;
 { $DEFINE LZX_USETHREADS}
 
 interface
-uses Classes, ChmBase, chmtypes, chmspecialfiles, HtmlIndexer, chmsitemap, Avl_Tree{$IFDEF LZX_USETHREADS}, lzxcompressthread{$ENDIF};
+uses Classes, ChmBase, chmtypes, chmspecialfiles, HtmlIndexer, chmsitemap, contnrs, Avl_Tree{$IFDEF LZX_USETHREADS}, lzxcompressthread{$ENDIF};
 
-type
+Const
+   DefaultHHC = 'Default.hhc';
+   DefaultHHK = 'Default.hhk';
 
+Type
   TGetDataFunc = function (const DataName: String; out PathInChm: String; out FileName: String; var Stream: TStream): Boolean of object;
   //  DataName :  A FileName or whatever so that the getter can find and open the file to add
   //  PathInChm:  This is the absolute path in the archive. i.e. /home/user/helpstuff/
@@ -149,6 +152,10 @@ Type
     FAvlURLStr    : TAVLTree;    // dedupe urltbl + binindex must resolve URL to topicid
     SpareString   : TStringIndex;
     SpareUrlStr   : TUrlStrIndex;
+    FWindows      : TObjectList;
+    FDefaultWindow: String;
+    FTocName      : String;
+    FIndexName    : String;
   protected
     procedure FileAdded(AStream: TStream; const AEntry: TFileEntryRec); override;
   private
@@ -163,13 +170,14 @@ Type
     procedure WriteURL_STR_TBL;
     procedure WriteOBJINST;
     procedure WriteFiftiMain;
+    procedure WriteWindows;
 
     function AddString(AString: String): LongWord;
     function AddURL(AURL: String; TopicsIndex: DWord): LongWord;
     procedure CheckFileMakeSearchable(AStream: TStream; AFileEntry: TFileEntryRec);
     function AddTopic(ATitle,AnUrl:AnsiString):integer;
     function NextTopicIndex: Integer;
-
+    procedure Setwindows (AWindowList:TObjectList);
 
   public
     constructor Create(AOutStream: TStream; FreeStreamOnDestroy: Boolean); override;
@@ -190,7 +198,10 @@ Type
     property HasBinaryIndex: Boolean read FHasBinaryIndex write FHasBinaryIndex;
     property DefaultFont: String read FDefaultFont write FDefaultFont;
     property DefaultPage: String read FDefaultPage write FDefaultPage;
-
+    property Windows : TObjectlist read fwindows write setwindows;
+    property TOCName : String read FTocName write FTocName;
+    property IndexName : String read FIndexName write FIndexName;
+    property DefaultWindow : string read fdefaultwindow write fdefaultwindow;
   end;
 
 implementation
@@ -1006,7 +1017,10 @@ begin
 
   // 0 Table of contents filename
   if FHasTOC then begin
-    TmpStr := 'default.hhc';
+    if fTocName ='' then
+      TmpStr := DefaultHHC
+    else
+      TmpStr := fTocName;
     FSection0.WriteWord(0);
     FSection0.WriteWord(NToLE(Word(Length(TmpStr)+1)));
     FSection0.Write(TmpStr[1], Length(TmpStr));
@@ -1015,17 +1029,25 @@ begin
   // 1
   // hhk Index
   if FHasIndex then begin
-    TmpStr := 'default.hhk';
+    if fIndexName='' then
+      TmpStr := DefaultHHK
+    else
+      TmpStr := fIndexName;
     FSection0.WriteWord(NToLE(Word(1)));
     FSection0.WriteWord(NToLE(Word(Length(TmpStr)+1)));
     FSection0.Write(TmpStr[1], Length(TmpStr));
     FSection0.WriteByte(0);
   end;
-  // 5 Default Window.
-  // Not likely needed
-// }
-  Entry.DecompressedSize := FSection0.Position - Entry.DecompressedOffset;
-  FInternalFiles.AddEntry(Entry);
+  // 5 Default Window
+
+  if FDefaultWindow<>'' then
+    begin
+      FSection0.WriteWord(NTOLE(Word(5)));
+      tmpstr:=FDefaultWindow;
+      FSection0.WriteWord(NToLE(Word(Length(TmpStr)+1)));
+      FSection0.Write(TmpStr[1], Length(TmpStr));
+      FSection0.WriteByte(0);
+    end;
 
   // 7 Binary Index
   if FHasBinaryIndex then
@@ -1045,6 +1067,10 @@ begin
     FSection0.WriteWord(NToLE(Word(4)));
     FSection0.WriteDWord(DWord(0)); // what is this number to be?
   end;
+
+
+  Entry.DecompressedSize := FSection0.Position - Entry.DecompressedOffset;
+  FInternalFiles.AddEntry(Entry);
 end;
 
 procedure TChmWriter.WriteITBITS;
@@ -1240,14 +1266,77 @@ begin
   PostAddStreamToArchive('$FIftiMain', '/', FFiftiMainStream);
 end;
 
+procedure TChmWriter.WriteWindows;
+Var WindowStream : TMemoryStream;
+    i,j          : Integer;
+    win          : TChmWindow;
+begin
+  if FWindows.Count>0 then
+    begin
+      WindowStream:=TMemoryStream.Create;
+      WindowStream.WriteDword(NToLE(dword(FWindows.Count)));
+      WindowStream.WriteDword(NToLE(dword(196))); // 1.1 or later. 188 is old style.
+      for i:=0 to FWindows.Count-1 Do
+        begin
+          Win:=TChmWindow(FWindows[i]);
+          WindowStream.WriteDword(NToLE(dword(196 )));                   //  0 size of entry.
+          WindowStream.WriteDword(NToLE(dword(0 )));                     //  4 unknown (bool Unicodestrings?)
+          WindowStream.WriteDword(NToLE(addstring(win.window_type )));   //  8 Arg 0, name of window
+          WindowStream.WriteDword(NToLE(dword(win.flags )));             //  C valid fields
+          WindowStream.WriteDword(NToLE(dword(win.nav_style)));          // 10 arg 10 navigation pane style
+          WindowStream.WriteDword(NToLE(addstring(win.title_bar_text))); // 14 Arg 1,  title bar text
+          WindowStream.WriteDword(NToLE(dword(win.styleflags)));         // 18 Arg 14, style flags
+          WindowStream.WriteDword(NToLE(dword(win.xtdstyleflags)));      // 1C Arg 15, xtd style flags
+          WindowStream.WriteDword(NToLE(dword(win.left)));               // 20 Arg 13, rect.left
+          WindowStream.WriteDword(NToLE(dword(win.top)));                // 24 Arg 13, rect.top
+          WindowStream.WriteDword(NToLE(dword(win.right)));              // 28 Arg 13, rect.right
+          WindowStream.WriteDword(NToLE(dword(win.bottom)));             // 2C Arg 13, rect.bottom
+          WindowStream.WriteDword(NToLE(dword(win.window_show_state)));  // 30 Arg 16, window show state
+          WindowStream.WriteDword(NToLE(dword(0)));                      // 34  -    , HWND hwndhelp                OUT: window handle"
+          WindowStream.WriteDword(NToLE(dword(0)));                      // 38  -    , HWND hwndcaller              OUT: who called this window"
+          WindowStream.WriteDword(NToLE(dword(0)));                      // 3C  -    , HH_INFO_TYPE paINFO_TYPES    IN: Pointer to an array of Information Types"
+          WindowStream.WriteDword(NToLE(dword(0)));                      // 40  -    , HWND hwndtoolbar             OUT: toolbar window in tri-pane window"
+          WindowStream.WriteDword(NToLE(dword(0)));                      // 44  -    , HWND hwndnavigation          OUT: navigation window in tri-pane window"
+          WindowStream.WriteDword(NToLE(dword(0)));                      // 48  -    , HWND hwndhtml                OUT: window displaying HTML in tri-pane window"
+          WindowStream.WriteDword(NToLE(dword(win.navpanewidth)));       // 4C Arg 11, width of nav pane
+          WindowStream.WriteDword(NToLE(dword(0)));                      // 50  -    , rect.left,   OUT:Specifies the coordinates of the Topic pane
+          WindowStream.WriteDword(NToLE(dword(0)));                      // 54  -    , rect.top ,   OUT:Specifies the coordinates of the Topic pane
+          WindowStream.WriteDword(NToLE(dword(0)));                      // 58  -    , rect.right,  OUT:Specifies the coordinates of the Topic pane
+          WindowStream.WriteDword(NToLE(dword(0)));                      // 5C  -    , rect.bottom, OUT:Specifies the coordinates of the Topic pane
+          WindowStream.WriteDword(NToLE(addstring(win.toc_file)));       // 60 Arg 2,  toc file
+          WindowStream.WriteDword(NToLE(addstring(win.index_file)));     // 64 Arg 3,  index file
+          WindowStream.WriteDword(NToLE(addstring(win.default_file)));   // 68 Arg 4,  default file
+          WindowStream.WriteDword(NToLE(addstring(win.home_button_file))); // 6c Arg 5,  home button file.
+          WindowStream.WriteDword(NToLE(dword(win.buttons)));            // 70 arg 12,
+          WindowStream.WriteDword(NToLE(dword(win.navpane_initially_closed))); // 74 arg 17
+          WindowStream.WriteDword(NToLE(dword(win.navpane_default)));    // 78 arg 18,
+          WindowStream.WriteDword(NToLE(dword(win.navpane_location)));   // 7C arg 19,
+          WindowStream.WriteDword(NToLE(dword(win.wm_notify_id)));       // 80 arg 20,
+          for j:=0 to 4 do
+            WindowStream.WriteDword(NToLE(dword(0)));                    // 84  -      byte[20] unknown -  "BYTE tabOrder[HH_MAX_TABS + 1]; // IN/OUT: tab order: Contents, Index, Search, History, Favorites, Reserved 1-5, Custom tabs"
+          WindowStream.WriteDword(NToLE(dword(0)));                      // 94  -      int cHistory; // IN/OUT: number of history items to keep (default is 30)
+          WindowStream.WriteDword(NToLE(addstring(win.Jumpbutton_1_Text)));  // 9C Arg 7,  The text of the Jump 1 button.
+          WindowStream.WriteDword(NToLE(addstring(win.Jumpbutton_2_Text)));  // A0 Arg 9,  The text of the Jump 2 button.
+          WindowStream.WriteDword(NToLE(addstring(win.Jumpbutton_1_File)));  // A4 Arg 6,  The file shown for Jump 1 button.
+          WindowStream.WriteDword(NToLE(addstring(win.Jumpbutton_2_File)));  // A8 Arg 8,  The file shown for Jump 1 button.
+          for j:=0 to 3 do
+            WindowStream.WriteDword(NToLE(dword(0)));                    // AA  -      byte[16] (TRECT) "RECT rcMinSize; // Minimum size for window (ignored in version 1)"
+          //   1.1+ fields
+          WindowStream.WriteDword(NToLE(dword(0)));                      // BC -       int cbInfoTypes; // size of paInfoTypes;
+          WindowStream.WriteDword(NToLE(dword(0)));                      // C0  -      LPCTSTR pszCustomTabs; // multiple zero-terminated strings
+        end;
+      WindowStream.Position := 0;
+      AddStreamToArchive('#WINDOWS', '/', WindowStream, True);
+      WindowStream.Free;
+    end;
+end;
+
 procedure TChmWriter.WriteInternalFilesAfter;
 begin
   // This creates and writes the #ITBITS (empty) file to section0
   WriteITBITS;
   // This creates and writes the #SYSTEM file to section0
   WriteSystem;
-
-
 end;
 
 procedure TChmWriter.WriteFinalCompressedFiles;
@@ -1256,6 +1345,7 @@ begin
   WriteTOPICS;
   WriteURL_STR_TBL;
   WriteSTRINGS;
+  WriteWINDOWS;
   WriteFiftiMain;
 end;
 
@@ -1287,6 +1377,8 @@ begin
   SpareString   := TStringIndex.Create;                 // We need an object to search in avltree
   SpareUrlStr   := TUrlStrIndex.Create;                 //    to avoid create/free circles we keep one in spare
                                                         //    for searching purposes
+  FWindows      := TObjectlist.Create(True);
+  FDefaultWindow:= '';
 end;
 
 destructor TChmWriter.Destroy;
@@ -1304,6 +1396,7 @@ begin
   FAvlUrlStr.Free;
   FAvlStrings.FreeAndClear;
   FAvlStrings.Free;
+  FWindows.Free;
 
   inherited Destroy;
 end;
@@ -1462,9 +1555,15 @@ begin
 end;
 
 procedure TChmWriter.AppendTOC(AStream: TStream);
+
+var tmpstr : string;
 begin
-  FHasTOC := True;
-  PostAddStreamToArchive('default.hhc', '/', AStream, True);
+  fHasTOC := True;
+  if fTocName = '' then
+    tmpstr := defaulthhc
+  else
+    tmpstr := fTocName;
+  PostAddStreamToArchive(tmpstr, '/', AStream, True);
 end;
 
 procedure TChmWriter.AppendBinaryTOCFromSiteMap(ASiteMap: TChmSiteMap);
@@ -2079,9 +2178,14 @@ begin
 end;
 
 procedure TChmWriter.AppendIndex(AStream: TStream);
+var tmpstr : string;
 begin
   FHasIndex := True;
-  PostAddStreamToArchive('default.hhk', '/', AStream, True);
+  if fIndexName = '' then
+    tmpstr:=defaulthhk
+  else
+    tmpstr:=fIndexName;
+  PostAddStreamToArchive(tmpstr, '/', AStream, True);
 end;
 
 procedure TChmWriter.AppendSearchDB(AName: String; AStream: TStream);
@@ -2106,5 +2210,20 @@ begin
   FContextStream.WriteDWord(Offset);
 end;
 
+procedure TChmWriter.SetWindows(AWindowList:TObjectList);
+
+var i : integer;
+    x : TCHMWindow;
+begin
+  FWindows.Clear;
+  for i:=0 to AWindowList.count -1 do
+    begin
+      x:=TChmWindow.Create;
+      x.assign(TChmWindow(AWindowList[i]));
+      Fwindows.Add(x);
+    end;
+end;
+
+
 end.