summaryrefslogtreecommitdiff
path: root/packages/chm
diff options
context:
space:
mode:
authormarco <marco@3ad0048d-3df7-0310-abae-a5850022a9f2>2010-07-11 12:55:56 +0000
committermarco <marco@3ad0048d-3df7-0310-abae-a5850022a9f2>2010-07-11 12:55:56 +0000
commitc03217f1840cbe9e9f5160c1413a29697e1406f8 (patch)
treeb805a8cefb9eb53b6952cd13528f33858f968c62 /packages/chm
parentc9a1ab9b655b896f53d460a438aee90398e45eab (diff)
downloadfpc-c03217f1840cbe9e9f5160c1413a29697e1406f8.tar.gz
* 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: http://svn.freepascal.org/svn/fpc/trunk@15550 3ad0048d-3df7-0310-abae-a5850022a9f2
Diffstat (limited to 'packages/chm')
-rw-r--r--packages/chm/src/chmcmd.lpr36
-rw-r--r--packages/chm/src/chmfilewriter.pas139
-rw-r--r--packages/chm/src/chmreader.pas151
-rw-r--r--packages/chm/src/chmtypes.pas82
-rw-r--r--packages/chm/src/chmwriter.pas151
5 files changed, 483 insertions, 76 deletions
diff --git a/packages/chm/src/chmcmd.lpr b/packages/chm/src/chmcmd.lpr
index 9fd680a4df..66262a8840 100644
--- a/packages/chm/src/chmcmd.lpr
+++ b/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.
diff --git a/packages/chm/src/chmfilewriter.pas b/packages/chm/src/chmfilewriter.pas
index 27e4a951ab..35e7d70f30 100644
--- a/packages/chm/src/chmfilewriter.pas
+++ b/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;
diff --git a/packages/chm/src/chmreader.pas b/packages/chm/src/chmreader.pas
index dc55d628be..f901cac1c6 100644
--- a/packages/chm/src/chmreader.pas
+++ b/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
diff --git a/packages/chm/src/chmtypes.pas b/packages/chm/src/chmtypes.pas
index 30f2eec4c7..16b982fdba 100644
--- a/packages/chm/src/chmtypes.pas
+++ b/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.
diff --git a/packages/chm/src/chmwriter.pas b/packages/chm/src/chmwriter.pas
index 96f13aeffa..0eb44ce207 100644
--- a/packages/chm/src/chmwriter.pas
+++ b/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.