* Patch from Andrew Haines to support FPDOC generating CHMs

git-svn-id: trunk@9406 -

packages/extra/chm/chmfilewriter.pas

@@ -36,6 +36,7 @@ type
 
   TChmProject = class
   private
+    FWriter: TChmWriter;
     FAutoFollowLinks: Boolean;
     FDefaultFont: String;
     FDefaultPage: String;
@@ -49,6 +50,7 @@ type
     FTitle: String;
   protected
     function GetData(const DataName: String; out PathInChm: String; out FileName: String; var Stream: TStream): Boolean;
+    procedure LastFileAdded(Sender: TObject);
   public
     constructor Create;
     destructor Destroy; override;
@@ -93,6 +95,25 @@ begin
   if Assigned(FOnProgress) then FOnProgress(Self, DataName);
 end;
 
+procedure TChmProject.LastFileAdded(Sender: TObject);
+var
+  IndexStream: TFileStream;
+  TOCStream: TFileStream;
+begin
+  // Assign the TOC and index files
+  if (IndexFileName <> '') and FileExists(IndexFileName) then begin
+    IndexStream := TFileStream.Create(IndexFileName, fmOpenRead);
+    FWriter.AppendIndex(IndexStream);
+    IndexStream.Free;
+  end;
+  if (TableOfContentsFileName <> '') and FileExists(TableOfContentsFileName) then begin
+    TOCStream := TFileStream.Create(TableOfContentsFileName, fmOpenRead);
+    FWriter.AppendTOC(TOCStream);
+    TOCStream.Free;
+  end;
+
+end;
+
 constructor TChmProject.Create;
 begin
   FFiles := TStringList.Create;
@@ -174,20 +195,11 @@ begin
   Writer := TChmWriter.Create(AOutStream, False);
   // our callback to get data
   Writer.OnGetFileData := @GetData;
+  Writer.OnLastFile    := @LastFileAdded;
   
   // give it the list of files
   Writer.FilesToCompress.AddStrings(Files);
 
-  // Assign the TOC and index files
-  if (IndexFileName <> '') and FileExists(IndexFileName) then begin
-    IndexStream := TFileStream.Create(IndexFileName, fmOpenRead);
-    Writer.IndexStream := IndexStream;
-  end;
-  if (TableOfContentsFileName <> '') and FileExists(TableOfContentsFileName) then begin
-    TOCStream := TFileStream.Create(TableOfContentsFileName, fmOpenRead);
-    Writer.TOCStream := TOCStream;
-  end;
-  
   // now some settings in the chm
   Writer.DefaultPage := DefaultPage;
   Writer.Title := Title;

packages/extra/chm/chmreader.pas

@@ -671,7 +671,7 @@ var
   I: Integer;
 begin
   Result := 0;
-
+  WriteLn('Looking for URL : ', Name);
   if Name = '' then Exit;
   if fDirectoryHeader.DirectoryChunkCount = 0 then exit;
 
@@ -1117,6 +1117,7 @@ begin
     Found := True;
   end;
   if not Found then exit;
+  WriteLn('Looking for URL ', URL, ' in ', AFileName);
   if CheckOpenFile(AFileName) then
     Result := fLastChm.ObjectExists(URL);
   if Result > 0 then NAme := Url;

packages/extra/chm/chmsitemap.pas

@@ -39,6 +39,7 @@ type
     FComment: String;
     FImageNumber: Integer;
     FIncreaseImageIndex: Boolean;
+    FKeyWord: String;
     FLocal: String;
     FOwner: TChmSiteMapItems;
     FSeeAlso: String;
@@ -50,6 +51,7 @@ type
     destructor Destroy; override;
     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;
@@ -81,6 +83,7 @@ type
     function NewItem: TChmSiteMapItem;
     function Insert(AItem: TChmSiteMapItem; AIndex: Integer): Integer;
     procedure Clear;
+    procedure Sort(Compare: TListSortCompare);
     property Item[AIndex: Integer]: TChmSiteMapItem read GetItem write SetItem;
     property Count: Integer read GetCount;
     property ParentItem: TChmSiteMapItem read FParentItem;
@@ -338,15 +341,15 @@ var
     Item: TChmSiteMapItem;
   begin
     for I := 0 to AItems.Count-1 do begin
-
-      
       Item := AItems.Item[I];
       WriteString('<LI> <OBJECT type="text/sitemap">');
       Inc(Indent, 8);
-      //Merge
+
-      //if (SiteMapType = stIndex) and (Item.Text <> '') then WriteParam('Keyword', Item.Text);
+      if (SiteMapType = stIndex) and (Item.Children.Count > 0) then
+         WriteParam('Keyword', Item.Text);
+      //if Item.KeyWord <> '' then WriteParam('Keyword', Item.KeyWord);
       if Item.Text <> '' then WriteParam('Name', Item.Text);
-      if Item.Local <> '' then WriteParam('Local', Item.Local);
+      if (Item.Local <> '') or (SiteMapType = stIndex) then WriteParam('Local', Item.Local);
       if Item.URL <> '' then WriteParam('URL', Item.URL);
       if (SiteMapType = stIndex) and (Item.SeeAlso <> '') then WriteParam('See Also', Item.SeeAlso);
       //if Item.FrameName <> '' then WriteParam('FrameName', Item.FrameName);
@@ -367,9 +370,6 @@ var
         Dec(Indent, 8);
         WriteString('</UL>');
       end;
-      
-
-
     end;
   end;
 begin
@@ -498,5 +498,10 @@ begin
   for I := Count-1 downto 0 do Delete(I);
 end;
 
+procedure TChmSiteMapItems.Sort(Compare: TListSortCompare);
+begin
+  FList.Sort(Compare);
+end;
+
 end.
 

packages/extra/chm/chmspecialfiles.pas

@@ -34,7 +34,7 @@ uses
   function WriteSpanInfoToStream(const AStream: TStream; UncompressedSize: QWord): Integer;
   function WriteTransformListToStream(const AStream: TStream): Integer;
   function WriteResetTableToStream(const AStream: TStream; ResetTableStream: TMemoryStream): Integer;
-  function WriteContentToStream(const AStream: TStream; ContentStream: TMemoryStream): Integer;
+  function WriteContentToStream(const AStream: TStream; ContentStream: TStream): Integer;
   
 implementation
 
@@ -120,7 +120,7 @@ begin
   Result := AStream.CopyFrom(ResetTableStream, ResetTableStream.Size-SizeOf(QWord));
 end;
 
-function WriteContentToStream(const AStream: TStream; ContentStream: TMemoryStream): Integer;
+function WriteContentToStream(const AStream: TStream; ContentStream: TStream): Integer;
 begin
   //  ::DataSpace/Storage/MSCompressed/Content
   ContentStream.Position := 0;

packages/extra/chm/chmwriter.pas

@@ -34,17 +34,14 @@ type
   //  Stream   :  the file opened with DataName should be written to this stream
 
 
-
   { TChmWriter }
 
   TChmWriter = class(TObject)
+    FOnLastFile: TNotifyEvent;
   private
   
-  
     ForceExit: Boolean;
     
-  
-  
     FDefaultFont: String;
     FDefaultPage: String;
     FFullTextSearch: Boolean;
@@ -56,16 +53,18 @@ type
     FStringsStream: TMemoryStream;
     FContextStream: TMemoryStream; // the #IVB file
     FSection0: TMemoryStream;
-    FSection1: TMemoryStream; // Compressed Stream
+    FSection1: TStream; // Compressed Stream
     FSection1Size: Int64;
     FSection1ResetTable: TMemoryStream; // has a list of frame positions NOT window positions
     FDirectoryListings: TStream;
-    FIndexStream: TStream;
     FOutStream: TStream;
     FFileNames: TStrings;
     FDestroyStream: Boolean;
+    FTempStream: TStream;
+    FPostStream: TStream;
     FTitle: String;
-    FTOCStream: TStream;
+    FHasTOC: Boolean;
+    FHasIndex: Boolean;
     FWindowSize: LongWord;
     FReadCompressedSize: Int64; // Current Size of Uncompressed data that went in Section1 (compressed)
     // Linear order of file
@@ -81,12 +80,11 @@ type
     // end linear header parts
     procedure InitITSFHeader;
     procedure InitHeaderSectionTable;
+    procedure SetTempRawStream(const AValue: TStream);
     procedure WriteHeader(Stream: TStream);
     procedure CreateDirectoryListings;
     procedure WriteDirectoryListings(Stream: TStream);
     procedure StartCompressingStream;
-    procedure WriteTOC;
-    procedure WriteIndex;
     procedure WriteSYSTEM;
     procedure WriteITBITS;
     procedure WriteSTRINGS;
@@ -106,19 +104,23 @@ type
     constructor Create(OutStream: TStream; FreeStreamOnDestroy: Boolean);
     destructor Destroy; override;
     procedure Execute;
+    procedure AppendTOC(AStream: TStream);
+    procedure AppendIndex(AStream: TStream);
+    procedure AppendSearchDB(AName: String; AStream: TStream);
     procedure AddStreamToArchive(AFileName, APath: String; AStream: TStream; Compress: Boolean = True);
+    procedure PostAddStreamToArchive(AFileName, APath: String; AStream: TStream; Compress: Boolean = True);
     procedure AddContext(AContext: DWord; ATopic: String);
     property WindowSize: LongWord read FWindowSize write FWindowSize default 2; // in $8000 blocks
     property FrameSize: LongWord read FFrameSize write FFrameSize default 1; // in $8000 blocks
     property FilesToCompress: TStrings read FFileNames;
     property OnGetFileData: TGetDataFunc read FOnGetFileData write FOnGetFileData;
+    property OnLastFile: TNotifyEvent read FOnLastFile write FOnLastFile;
     property OutStream: TStream read FOutStream;
     property Title: String read FTitle write FTitle;
     property FullTextSearch: Boolean read FFullTextSearch write FFullTextSearch;
     property DefaultFont: String read FDefaultFont write FDefaultFont;
     property DefaultPage: String read FDefaultPage write FDefaultPage;
-    property TOCStream: TStream read FTOCStream write FTOCStream;
+    property TempRawStream: TStream read FTempStream write SetTempRawStream;
-    property IndexStream: TStream read FIndexStream write FIndexStream;
     //property LocaleID: dword read ITSFHeader.LanguageID write ITSFHeader.LanguageID;
   end;
 
@@ -200,6 +202,18 @@ begin
   HeaderSuffix.Offset := NToLE(HeaderSuffix.Offset);
 end;
 
+procedure TChmWriter.SetTempRawStream(const AValue: TStream);
+begin
+  if (FCurrentStream.Size > 0) or (FSection1.Size > 0) then
+    raise Exception.Create('Cannot set the TempRawStream once data has been written to it!');
+  if AValue = nil then
+    raise Exception.Create('TempRawStream cannot be nil!');
+  if FCurrentStream = AValue then
+    exit;
+  FCurrentStream.Free;
+  FCurrentStream := AValue;
+end;
+
 procedure TChmWriter.WriteHeader(Stream: TStream);
 begin
   Stream.Write(ITSFHeader, SizeOf(TITSFHeader));
@@ -225,8 +239,7 @@ var
   FESize: Integer;
   FileName: String;
   FileNameSize: Integer;
-  LastListIndex,
+  LastListIndex: Integer;
-  LastIndexIndex: Integer;
   FirstListEntry: TFirstListEntry;
   ChunkIndex: Integer;
   ListHeader: TPMGListChunk;
@@ -312,7 +325,6 @@ begin
   IndexBlock := TPMGIDirectoryChunk.Create(SizeOf(TPMGIIndexChunk));
   ListingBlock := TDirectoryChunk.Create(SizeOf(TPMGListChunk));
 
-  LastIndexIndex := -1;
   LastListIndex  := -1;
 
   // add files to a pmgl block until it is full.
@@ -373,24 +385,9 @@ begin
   //TMemoryStream(FDirectoryListings).SaveToFile('dirlistings.pmg');
 end;
 
-procedure TChmWriter.WriteIndex;
-var
-  Entry: TFileEntryRec;
-  TmpTitle: String;
-begin
-  if IndexStream = nil then Exit;
-
-  if Title <> '' then TmpTitle := Title
-  else TmpTitle := 'default';
-  
-  AddStreamToArchive(TmpTitle+'.hhk', '/', IndexStream);
-end;
-
 procedure TChmWriter.WriteSystem;
 var
   Entry: TFileEntryRec;
-  EntryCode,
-  EntryLength: Word;
   TmpStr: String;
   TmpTitle: String;
 const
@@ -449,6 +446,7 @@ begin
     FSection0.WriteWord(NToLE(Word(3)));
     FSection0.WriteWord(NToLE(Word(Length(FTitle)+1)));
     FSection0.Write(FTitle[1], Length(FTitle));
+    FSection0.WriteByte(0);
   end;
 
   // 16 Default Font
@@ -456,14 +454,15 @@ begin
     FSection0.WriteWord(NToLE(Word(16)));
     FSection0.WriteWord(NToLE(Word(Length(FDefaultFont)+1)));
     FSection0.Write(FDefaultFont[1], Length(FDefaultFont));
+    FSection0.WriteByte(0);
   end;
   
   // 6
   // unneeded. if output file is :  /somepath/OutFile.chm the value here is outfile(lowercase)
   
   // 0 Table of contents filename
-  if TOCStream <> nil then begin
+  if FHasTOC then begin
-    TmpStr := TmpTitle+'.hhc';
+    TmpStr := 'default.hhc';
     FSection0.WriteWord(0);
     FSection0.WriteWord(NToLE(Word(Length(TmpStr)+1)));
     FSection0.Write(TmpStr[1], Length(TmpStr));
@@ -471,8 +470,8 @@ begin
   end;
   // 1
   // hhk Index
-  if IndexStream <> nil then begin
+  if FHasIndex then begin
-    TmpStr := TmpTitle+'.hhk';
+    TmpStr := 'default.hhk';
     FSection0.WriteWord(NToLE(Word(1)));
     FSection0.WriteWord(NToLE(Word(Length(TmpStr)+1)));
     FSection0.Write(TmpStr[1], Length(TmpStr));
@@ -530,7 +529,7 @@ begin
   FSection0.Write(DISCLAIMER_STR, SizeOf(DISCLAIMER_STR));
   Entry.DecompressedSize := FSection0.Position - Entry.DecompressedOffset;
   Entry.Path := '/';
-  Entry.Name := '_::_README_::_'; //try to use a name that won't conflict with normal names
+  Entry.Name := '_#_README_#_'; //try to use a name that won't conflict with normal names
   FInternalFiles.AddEntry(Entry);
 end;
 
@@ -649,6 +648,19 @@ begin
       Inc(FReadCompressedSize,  FileEntry.DecompressedSize);
       FCurrentStream.Position := 0;
     end;
+
+    // this is intended for programs to add perhaps a file
+    // after all the other files have been added.
+    if (AtEndOfData)
+    and (FCurrentStream <> FPostStream) then
+    begin
+      if Assigned(FOnLastFile) then
+        FOnLastFile(Self);
+      FCurrentStream.Free;
+      FCurrentStream := FPostStream;
+      FCurrentStream.Position := 0;
+      Inc(FReadCompressedSize, FCurrentStream.Size);
+    end;
   end;
 end;
 
@@ -661,11 +673,11 @@ function TChmWriter.WriteCompressedData(Count: Longint; Buffer: Pointer): LongIn
 begin
   // we allocate a MB at a time to limit memory reallocation since this
   // writes usually 2 bytes at a time
-  if FSection1.Position >= FSection1.Size-1 then begin
+  if (FSection1 is TMemoryStream) and (FSection1.Position >= FSection1.Size-1) then begin
     FSection1.Size := FSection1.Size+$100000;
   end;
-  Inc(FSection1Size, FSection1.Write(Buffer^, Count));
+  Result := FSection1.Write(Buffer^, Count);
-
+  Inc(FSection1Size, Result);
 end;
 
 procedure _MarkFrame(arg: pointer; UncompressedTotal, CompressedTotal: LongWord); cdecl;
@@ -693,7 +705,6 @@ procedure TChmWriter.MarkFrame(UnCompressedTotal, CompressedTotal: LongWord);
   procedure UpdateTotalSizes;
   var
     OldPos: Int64;
-    Value: DWord;
   begin
     OldPos := FSection1ResetTable.Position;
     FSection1ResetTable.Position := $10;
@@ -701,8 +712,6 @@ procedure TChmWriter.MarkFrame(UnCompressedTotal, CompressedTotal: LongWord);
     WriteQWord(CompressedTotal);
     FSection1ResetTable.Position := OldPos;
   end;
-var
-  Tmp : QWord;
 begin
   if FSection1ResetTable.Size = 0 then begin
     // Write the header
@@ -733,6 +742,7 @@ begin
   FSection1 := TMemoryStream.Create;
   FSection1ResetTable := TMemoryStream.Create;
   FDirectoryListings := TMemoryStream.Create;
+  FPostStream := TMemoryStream.Create;;
   FDestroyStream := FreeStreamOnDestroy;
   FFileNames := TStringList.Create;
 end;
@@ -760,8 +770,6 @@ begin
 
   // write any internal files to FCurrentStream that we want in the compressed section
   WriteIVB;
-  WriteTOC;
-  WriteIndex;
   WriteSTRINGS;
   
   // written to Section0 (uncompressed)
@@ -798,10 +806,27 @@ begin
   WriteSection1; // writes section 1 to FOutStream
 end;
 
+procedure TChmWriter.AppendTOC(AStream: TStream);
+begin
+  FHasTOC := True;
+  PostAddStreamToArchive('default.hhc', '/', AStream, True);
+end;
+
+procedure TChmWriter.AppendIndex(AStream: TStream);
+begin
+  FHasIndex := True;
+  PostAddStreamToArchive('default.hhk', '/', AStream, True);
+end;
+
+procedure TChmWriter.AppendSearchDB(AName: String; AStream: TStream);
+begin
+  PostAddStreamToArchive(AName, '/', AStream);
+end;
+
 
 // this procedure is used to manually add files to compress to an internal stream that is
 // processed before FileToCompress is called. Files added this way should not be
-// in the FilesToCompress property.
+// duplicated in the FilesToCompress property.
 procedure TChmWriter.AddStreamToArchive(AFileName, APath: String; AStream: TStream; Compress: Boolean = True);
 var
   TargetStream: TStream;
@@ -823,6 +848,31 @@ begin
   TargetStream.CopyFrom(AStream, AStream.Size);
 end;
 
+procedure TChmWriter.PostAddStreamToArchive(AFileName, APath: String;
+  AStream: TStream; Compress: Boolean);
+var
+  TargetStream: TStream;
+  Entry: TFileEntryRec;
+begin
+  if AStream = nil then Exit;
+  if Compress then
+    TargetStream := FPostStream
+  else
+    TargetStream := FSection0;
+
+  Entry.Name := AFileName;
+  Entry.Path := APath;
+  Entry.Compressed :=  Compress;
+  if not Compress then
+    Entry.DecompressedOffset := TargetStream.Position
+  else
+    Entry.DecompressedOffset := FReadCompressedSize + TargetStream.Position;
+  Entry.DecompressedSize := AStream.Size;
+  FInternalFiles.AddEntry(Entry);
+  AStream.Position := 0;
+  TargetStream.CopyFrom(AStream, AStream.Size);
+end;
+
 procedure TChmWriter.AddContext(AContext: DWord; ATopic: String);
 var
   Offset: DWord;
@@ -858,16 +908,4 @@ begin
   lzx_finish(LZXdata, nil);
 end;
 
-procedure TChmWriter.WriteTOC;
-var
-  TmpTitle: String;
-begin
-  if TOCStream = nil then Exit;
-  if Title <> '' then TmpTitle := Title
-  else TmpTitle := 'default';
-
-  AddStreamToArchive(TmpTitle+'.hhc', '/', TOCStream);
-end;
-
-
 end.