--- Merging r15182 into '.':

U    packages/fcl-passrc/src/pscanner.pp
A    packages/fcl-passrc/examples
A    packages/fcl-passrc/examples/test_parser.pp
--- Merging r15444 into '.':
U    packages/chm/src/chmfilewriter.pas
U    packages/chm/src/chmtypes.pas
--- Merging r15547 into '.':
U    packages/chm/src/paslzxcomp.pas
U    packages/chm/src/chmbase.pas
U    packages/chm/src/chmwriter.pas
U    packages/chm/src/lzxcompressthread.pas
U    packages/chm/src/chmreader.pas
--- Merging r15550 into '.':
G    packages/chm/src/chmfilewriter.pas
G    packages/chm/src/chmwriter.pas
U    packages/chm/src/chmcmd.lpr
G    packages/chm/src/chmreader.pas
G    packages/chm/src/chmtypes.pas
--- Merging r15558 into '.':
G    packages/chm/src/chmfilewriter.pas
G    packages/chm/src/chmcmd.lpr
--- Merging r15559 into '.':
U    packages/fcl-passrc/src/pastree.pp
U    packages/fcl-passrc/src/pparser.pp
--- Merging r15563 into '.':
G    packages/chm/src/chmcmd.lpr
U    packages/chm/src/chmls.lpr
G    packages/chm/src/chmreader.pas
--- Merging r15578 into '.':
G    packages/chm/src/chmfilewriter.pas
G    packages/chm/src/chmcmd.lpr
G    packages/chm/src/chmls.lpr

# revisions: 15182,15444,15547,15550,15558,15559,15563,15578
------------------------------------------------------------------------
r15182 | marco | 2010-04-26 15:17:26 +0200 (Mon, 26 Apr 2010) | 2 lines
Changed paths:
   A /trunk/packages/fcl-passrc/examples
   A /trunk/packages/fcl-passrc/examples/test_parser.pp
   M /trunk/packages/fcl-passrc/src/pscanner.pp

 * fix for mantis 16344 (quoted filename in $include ) + testparser example from that series of bugreports.

------------------------------------------------------------------------
------------------------------------------------------------------------
r15444 | marco | 2010-06-17 11:04:25 +0200 (Thu, 17 Jun 2010) | 7 lines
Changed paths:
   M /trunk/packages/chm/src/chmfilewriter.pas
   M /trunk/packages/chm/src/chmtypes.pas

 * initial hhp loading in chmproject.
 * chmproject now supports #Windows (the CHM feature, not the OS), but doesn't pass it to writer yet.
 * Some keys in chmproject moved from files/ to settings/ were they belong.
     hopefully with backwards compat loading capability.

Low errorchecking etc, and only initially tested. Not for 2.4.2

------------------------------------------------------------------------
------------------------------------------------------------------------
r15547 | andrew | 2010-07-11 14:13:36 +0200 (Sun, 11 Jul 2010) | 4 lines
Changed paths:
   M /trunk/packages/chm/src/chmbase.pas
   M /trunk/packages/chm/src/chmreader.pas
   M /trunk/packages/chm/src/chmwriter.pas
   M /trunk/packages/chm/src/lzxcompressthread.pas
   M /trunk/packages/chm/src/paslzxcomp.pas

* Fixed a potential bug where a value would not change if a contition wasn't met
* Made TITSFReader friendlier for inherited classes
* Small fix for threaded lzx compressor

------------------------------------------------------------------------
------------------------------------------------------------------------
r15550 | marco | 2010-07-11 14:55:56 +0200 (Sun, 11 Jul 2010) | 4 lines
Changed paths:
   M /trunk/packages/chm/src/chmcmd.lpr
   M /trunk/packages/chm/src/chmfilewriter.pas
   M /trunk/packages/chm/src/chmreader.pas
   M /trunk/packages/chm/src/chmtypes.pas
   M /trunk/packages/chm/src/chmwriter.pas

 * 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
------------------------------------------------------------------------
------------------------------------------------------------------------
r15558 | marco | 2010-07-12 22:10:21 +0200 (Mon, 12 Jul 2010) | 1 line
Changed paths:
   M /trunk/packages/chm/src/chmcmd.lpr
   M /trunk/packages/chm/src/chmfilewriter.pas

 * Improved link scanning, and chmcmd commandline handling
------------------------------------------------------------------------
------------------------------------------------------------------------
r15559 | michael | 2010-07-12 22:56:43 +0200 (Mon, 12 Jul 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-passrc/src/pastree.pp
   M /trunk/packages/fcl-passrc/src/pparser.pp

* Patch from Dmitry Boyarintsev to implement expression parsing. Improved to have operator as enumerated
------------------------------------------------------------------------
------------------------------------------------------------------------
r15563 | marco | 2010-07-13 19:57:49 +0200 (Tue, 13 Jul 2010) | 3 lines
Changed paths:
   M /trunk/packages/chm/src/chmcmd.lpr
   M /trunk/packages/chm/src/chmls.lpr
   M /trunk/packages/chm/src/chmreader.pas

 * fixed a problem in chmreader wrt moment of fwindows creation
 * removed a redundant line from chmcmd (leftover from the getopts example)
 * reworking chmls on a getopts basis, like chmcmd, and make it support extracting files. (no wildcards (yet))
------------------------------------------------------------------------
------------------------------------------------------------------------
r15578 | marco | 2010-07-15 10:58:54 +0200 (Thu, 15 Jul 2010) | 2 lines
Changed paths:
   M /trunk/packages/chm/src/chmcmd.lpr
   M /trunk/packages/chm/src/chmfilewriter.pas
   M /trunk/packages/chm/src/chmls.lpr

 * more little fixes from initial testing. Mostly errormessages and .hhp defaults.
  chmls -n switch
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@16362 -

.gitattributes

@@ -1524,6 +1524,7 @@ packages/fcl-net/src/win/resolve.inc svneol=native#text/plain
 packages/fcl-net/src/xmlrpc.pp svneol=native#text/plain
 packages/fcl-passrc/Makefile svneol=native#text/plain
 packages/fcl-passrc/Makefile.fpc svneol=native#text/plain
+packages/fcl-passrc/examples/test_parser.pp svneol=native#text/plain
 packages/fcl-passrc/fpmake.pp svneol=native#text/plain
 packages/fcl-passrc/src/pastree.pp svneol=native#text/plain
 packages/fcl-passrc/src/paswrite.pp svneol=native#text/plain

packages/chm/src/chmbase.pas

@@ -36,8 +36,6 @@ type
     Unknown_1: LongWord;
     TimeStamp: LongWord; //bigendian
     LanguageID: LongWord;
-    Guid1: TGuid;
-    Guid2: TGuid;
   end;
   TITSFHeaderEntry = record
     PosFromZero: QWord;
@@ -78,7 +76,7 @@ type
     Unknown5: LongInt; // = -1
   end;
   
-  TPMGchunktype = (ctPMGL, ctPMGI, ctUnknown);
+  TDirChunkType = (ctPMGL, ctPMGI, ctAOLL, ctAOLI, ctUnknown);
   
   TPMGListChunk = record
     PMGLsig: array [0..3] of char;

packages/chm/src/chmcmd.lpr

@@ -23,33 +23,200 @@ program chmcmd;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, chmfilewriter;
+  Classes, Sysutils, chmfilewriter, GetOpts;
 
 Procedure Usage;
 
 begin
-  Writeln(StdErr,'Usage: chmcmd  <filename>');
+  Writeln(StdErr,'Usage: chmcmd [options] <filename>');
+  writeln(stderr);
+  writeln(stderr,'The following options are available :');
+  writeln(stderr,' --html-scan       : scan html for missing files or alinks  ');
+  writeln(stderr,' --no-html-scan    : don''t scan html for missing files or alinks ');
+  writeln(stderr,' -h, --help        : print this text');
+  writeln(stderr,'--verbosity number : set verbosity level 0..5, 0 is least');
+  writeln(stderr,'--generate-xml     : (if .hhp file), also generate a xml project from .hhp');
+  writeln(stderr);
+  writeln(stderr,' .hhp projects are default scanned for html, .xml not');
   Halt(1);
 end;
 
 
+var
+  theopts : array[1..5] of TOption;
+
+procedure InitOptions;
+
+begin
+  with theopts[1] do
+   begin
+    name:='html-scan';
+    has_arg:=0;
+    flag:=nil;
+    value:=#0;
+  end;
+  with theopts[2] do
+   begin
+    name:='no-html-scan';
+    has_arg:=0;
+    flag:=nil;
+    value:=#0;
+  end;
+  with theopts[3] do
+   begin
+    name:='verbosity';
+    has_arg:=1;
+    flag:=nil;
+    value:=#0;
+  end;
+  with theopts[4] do
+   begin
+    name:='generate-xml';
+    has_arg:=0;
+    flag:=nil;
+    value:=#0;
+  end;
+  with theopts[5] do
+   begin
+    name:='help';
+    has_arg:=0;
+    flag:=nil;
+  end;
+  with theopts[6] do
+   begin
+    name:='';
+    has_arg:=0;
+    flag:=nil;
+  end;
+end;
+
+Type THtmlScanenum = (scandefault,scanforce,scanforcedno);
+
+var
+  GenerateXMLForHHP  : boolean = false;
+  alloweddetaillevel : integer = 0;     // show if msg.detaillevel<=allowdetaillevel
+  htmlscan           : THtmlScanEnum = Scandefault;
+
+procedure OnError (Project: TChmProject;errorkind:TChmProjectErrorKind;msg:String;detailevel:integer=0);
+begin
+  if detailevel<=alloweddetaillevel then
+    if errorkind<>chmnone then
+      writeln(ChmErrorKindText[errorkind],': ',msg)
+    else
+      writeln(msg);
+end;
+
+procedure Processfile(name:string);
+
 var
   OutStream: TFileStream;
   Project: TChmProject;
+  xmlname: string;
+  ishhp  : boolean;
 
 begin
-  if (Paramcount=1) and (ParamStr(1)<>'-h') and (ParamStr(1)<>'-?') then 
+  ishhp:=uppercase(extractfileext(name))='.HHP';
+  Project := TChmProject.Create;
+  if ishhp then
     begin
-    Project := TChmProject.Create;
-    Project.LoadFromFile(ParamStr(1));
-    OutStream := TFileStream.Create(Project.OutputFileName, fmCreate, fmOpenWrite);
-    Project.WriteChm(OutStream);
-    OutStream.Free;
-    Project.Free;
+      xmlname:=changefileext(name,'.hhp.xml');
+      Project.OnError:=@OnError;
+      try
+        Project.LoadFromHHP(name,false) ;          // we need a param for this second param later
+       except
+         on e:exception do
+           begin
+             Writeln('This HHP CHM project seems corrupt, please check it ',name);
+             halt(1);
+           end;
+       end;
+      project.ScanHtmlContents:=htmlscan<>scanforcedno;  // .hhp default SCAN
     end
   else
     begin
-    Usage;
-    end; 
+     try
+      project.ScanHtmlContents:=htmlscan=scanforce;  // .hhp default SCAN
+      Project.LoadFromFile(name);
+     except
+       on e:exception do
+         begin
+           Writeln('This XML CHM project seems corrupt, please check it ',name);
+           halt(1);
+         end;
+       end;
+    end;
+  OutStream := TFileStream.Create(Project.OutputFileName, fmCreate, fmOpenWrite);
+  Project.WriteChm(OutStream);
+  if ishhp and GenerateXMLForHHP then
+    begin
+      Writeln('Generating XML ',xmlname,'.');
+      Project.SaveToFile(xmlname);
+    end;
+  OutStream.Free;
+  Project.Free;
+
+end;
+
+var
+  name   : string;
+  optionindex : integer;
+  c      : char;
+  verbtemp : integer;
+  verbbool : boolean;
+
+begin
+  InitOptions;
+  Writeln(stderr,'chmcmd, a CHM compiler. (c) 2010 Free Pascal core.');
+  Writeln(Stderr);
+  repeat
+    c:=getlongopts('h',@theopts[1],optionindex);
+    case c of
+      #0 : begin
+             case optionindex-1 of
+               0 : htmlscan:=scanforce;
+               1 : htmlscan:=scanforcedno;
+               2 : begin
+                     verbbool:=trystrtoint(optarg,verbtemp);
+                     if verbbool then
+                       verbbool:=(verbtemp>=0) and (verbtemp<6);
+                     if verbbool then
+                       alloweddetaillevel:=verbtemp
+                     else
+                       begin
+                         Writeln('Illegal value for switch --verbosity :',optarg);
+                         Usage;
+                         Halt;
+                       end;
+                   end;
+               3 : GenerateXMLForHHP:=true;
+               4 : begin;
+                    Usage;
+                    Halt;
+                   end;
+                end;
+           end;
+      '?' : begin
+              writeln('unknown option',optopt);
+              usage;
+              halt;
+            end;
+   end; { case }
+ until c=endofoptions;
+ if (paramcount-optind)=0 then  // if equal, then 1 parameter
+    begin
+      name:=paramstr(optind);
+      if not fileexists(name) then
+        begin
+          Writeln('Can''t find project file ',name);
+          halt;
+        end;
+      ProcessFile(Name);
+    end
+ else
+   begin
+     Writeln('Invalid number of parameters :', paramcount-optind+1);
+     Usage;
+     halt;
+   end;
 end.
 

packages/chm/src/chmfilewriter.pas

@@ -25,12 +25,15 @@ unit chmfilewriter;
 interface
 
 uses
-  Classes, SysUtils, chmwriter;
+  Classes, SysUtils, chmwriter, inifiles, contnrs,
+  {for html scanning } dom,SAX_HTML,dom_html;
 
 type
   TChmProject = class;
+  TChmProjectErrorKind = (chmerror,chmwarning,chmhint,chmnote,chmnone);
 
   TChmProgressCB = procedure (Project: TChmProject; CurrentFile: String) of object;
+  TChmErrorCB    = procedure (Project: TChmProject;errorkind:TChmProjectErrorKind;msg:String;detaillevel:integer=0);
 
   { TChmProject }
 
@@ -46,25 +49,37 @@ type
     FMakeSearchable: Boolean;
     FFileName: String;
     FOnProgress: TChmProgressCB;
+    FOnError   : TChmErrorCB;
     FOutputFileName: String;
     FTableOfContentsFileName: String;
     FTitle: String;
+    FWindows : TObjectList;
+    FMergeFiles : TStringlist;
+    fDefaultWindow : string;
+    fScanHtmlContents  : Boolean;
+    fOtherFiles : TStrings; // Files found in a scan.
+    fAllowedExtensions: TStringList;
   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;
     procedure LoadFromFile(AFileName: String); virtual;
+    procedure LoadFromhhp (AFileName:String;LeaveInclude:Boolean); virtual;
     procedure SaveToFile(AFileName: String); virtual;
     procedure WriteChm(AOutStream: TStream); virtual;
     function ProjectDir: String;
     procedure AddFileWithContext(contextid:integer;filename:ansistring;contextname:ansistring='');
+    procedure Error(errorkind:TChmProjectErrorKind;msg:String;detaillevel:integer=0);
     // 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;
     property FileName: String read FFileName write FFileName;
-    property Files: TStrings read FFiles write FFiles;
+    property Files: TStrings read FFiles write FFiles;  // html files
+    property OtherFiles: TStrings read FOtherFiles write FOtherFiles;  // other files (.css, img etc)
     property AutoFollowLinks: Boolean read FAutoFollowLinks write FAutoFollowLinks;
     property TableOfContentsFileName: String read FTableOfContentsFileName write FTableOfContentsFileName;
     property MakeBinaryTOC: Boolean read FMakeBinaryTOC write FMakeBinaryTOC;
@@ -74,8 +89,13 @@ type
     property MakeSearchable: Boolean read FMakeSearchable write FMakeSearchable;
     property DefaultPage: String read FDefaultPage write FDefaultPage;
     property DefaultFont: String read FDefaultFont write FDefaultFont;
-
+    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;
+    property AllowedExtensions : TStringList read FAllowedExtensions;
   end;
 
   TChmContextNode = Class
@@ -84,9 +104,14 @@ type
                      ContextName   : AnsiString;
                     End;
 
+
+
+Const
+  ChmErrorKindText : array[TCHMProjectErrorKind] of string = ('Error','Warning','Hint','Note','');
+
 implementation
 
-uses XmlCfg, chmsitemap;
+uses XmlCfg, chmsitemap, CHMTypes;
 
 { TChmProject }
 
@@ -153,6 +178,13 @@ end;
 constructor TChmProject.Create;
 begin
   FFiles := TStringList.Create;
+  FOtherFiles := TStringList.Create;
+  FAllowedExtensions:=TStringList.Create;
+  FAllowedExtensions.add('.HTM');
+  FAllowedExtensions.add('.HTML');
+  FWindows:=TObjectList.Create(True);
+  FMergeFiles:=TStringlist.Create;
+  ScanHtmlContents:=False;
 end;
 
 destructor TChmProject.Destroy;
@@ -160,16 +192,113 @@ var i : integer;
 begin
   for i:=0 to ffiles.count -1 do
     ffiles.objects[i].free;
+  FMergeFiles.Free;
   FFiles.Free;
+  FOtherFiles.Free;
+  FWindows.Free;
   inherited Destroy;
 end;
 
+
+Type
+   TSectionEnum = (secOptions,secWindows,secFiles,secMergeFiles,secAlias,secMap,secInfoTypes,secTextPopups,secUnknown);
+   TOptionEnum = (OPTAUTO_INDEX,OPTAUTO_TOC,OPTBINARY_INDEX,OPTBINARY_TOC,OPTCITATION,
+       OPTCOMPRESS,OPTCOPYRIGHT,OPTCOMPATIBILITY,OPTCOMPILED_FILE,OPTCONTENTS_FILE,
+       OPTCREATE_CHI_FILE,OPTDBCS,OPTDEFAULT_FONT,OPTDEFAULT_WINDOW,OPTDEFAULT_TOPIC,
+       OPTDISPLAY_COMPILE_NOTES,OPTDISPLAY_COMPILE_PROGRESS,OPTENHANCED_DECOMPILATION,OPTERROR_LOG_FILE,OPTFLAT,
+       OPTFULL_TEXT_SEARCH_STOP_LIST,OPTFULL_TEXT_SEARCH,OPTIGNORE,OPTINDEX_FILE,OPTLANGUAGE,OPTPREFIX,
+       OPTSAMPLE_STAGING_PATH,OPTSAMPLE_LIST_FILE,OPTTMPDIR,OPTTITLE,OPTCUSTOM_TAB,OPTUNKNOWN);
+
+Const
+  SectionNames : Array[TSectionEnum] of String =
+      ('OPTIONS','WINDOWS','FILES','MERGE FILES','ALIAS','MAP','INFOTYPES','TEXT POPUPS','UNKNOWN');
+
+  OptionKeys : array [TOptionEnum] of String =
+      ('AUTO INDEX','AUTO TOC','BINARY INDEX','BINARY TOC','CITATION',
+       'COMPRESS','COPYRIGHT','COMPATIBILITY','COMPILED FILE','CONTENTS FILE',
+       'CREATE CHI FILE','DBCS','DEFAULT FONT','DEFAULT WINDOW','DEFAULT TOPIC',
+       'DISPLAY COMPILE NOTES','DISPLAY COMPILE PROGRESS','ENHANCED DECOMPILATION','ERROR LOG FILE','FLAT',
+       'FULL-TEXT SEARCH STOP LIST','FULL TEXT SEARCH','IGNORE','INDEX FILE','LANGUAGE','PREFIX',
+       'SAMPLE STAGING PATH','SAMPLE LIST FILE','TMPDIR','TITLE','CUSTOM TAB','UNKNOWN');
+
+
+
+function FindSectionName (const name:string):TSectionEnum;
+
+begin
+  result:=low(TSectionEnum);
+  while (result<secUnknown) and (name<>SectionNames[Result]) do
+    inc(result);
+end;
+
+function FindOptionName(Const name:string):TOptionEnum;
+
+begin
+  result:=low(TOptionEnum);
+  while (result<optUnknown) and (name<>OptionKeys[Result]) do
+    inc(result);
+end;
+
+procedure TChmProject.readIniOptions(keyvaluepairs:tstringlist);
+var i : integer;
+    Opt : TOptionEnum;
+    OptVal,
+    OptValUpper : string;
+begin
+  for i:=0 to keyvaluepairs.count-1 do
+    begin
+      Opt:=findoptionname(uppercase(keyvaluepairs.names[i]));
+      optval :=keyvaluepairs.valuefromindex[i];
+      optvalupper:=uppercase(OptVal);
+      case Opt Of
+      OPTAUTO_INDEX                : ;
+      OPTAUTO_TOC                  : ;
+      OPTBINARY_INDEX              : MakeBinaryIndex:=optvalupper='YES';
+      OPTBINARY_TOC                : MakeBinaryToc  :=optvalupper='YES';
+      OPTCITATION                  : ;
+      OPTCOMPRESS                  : ; // Doesn't seem to have effect in workshop
+      OPTCOPYRIGHT                 : ;
+      OPTCOMPATIBILITY             : ;
+      OPTCOMPILED_FILE             : OutputFilename:=optval;
+      OPTCONTENTS_FILE             : TableOfContentsFileName:=optval;
+      OPTCREATE_CHI_FILE           : ;
+      OPTDBCS                      : ; // What this field makes unicode is not known?
+      OPTDEFAULT_FONT              : defaultfont:=optval;
+      OPTDEFAULT_WINDOW            : defaultwindow:=optval;
+      OPTDEFAULT_TOPIC             : defaultpage:=optval;
+      OPTDISPLAY_COMPILE_NOTES     : ;
+      OPTDISPLAY_COMPILE_PROGRESS  : ;
+      OPTENHANCED_DECOMPILATION    : ;
+      OPTERROR_LOG_FILE            : ;
+      OPTFLAT                      : ;
+      OPTFULL_TEXT_SEARCH_STOP_LIST: ;
+      OPTFULL_TEXT_SEARCH          : MakeSearchable:=optvalupper='YES';
+      OPTIGNORE                    : ;
+      OPTINDEX_FILE                : Indexfilename:=optval;
+      OPTLANGUAGE                  : ;
+      OPTPREFIX                    : ;  // doesn't seem to have effect
+      OPTSAMPLE_STAGING_PATH       : ;
+      OPTSAMPLE_LIST_FILE          : ;
+      OPTTMPDIR                    : ;
+      OPTTITLE                     : Title:=optval;
+      OPTCUSTOM_TAB                : ;
+      OPTUNKNOWN                   : ;  // can be used for errors on unknown keys
+      end;
+    end;
+end;
+
+
 procedure TChmProject.LoadFromFile(AFileName: String);
 var
   Cfg: TXMLConfig;
+  MergeFileCount,
+  WinCount,
   FileCount: Integer;
   I  : Integer;
   nd : TChmContextNode;
+  win: TCHMWindow;
+  s  : String;
+
 begin
   Cfg := TXMLConfig.Create(nil);
   Cfg.Filename := AFileName;
@@ -185,20 +314,270 @@ begin
       nd.contextname:=Cfg.GetValue('Files/FileName'+IntToStr(I)+'/ContextName','');
       Files.AddObject(nd.urlname,nd);
     end;
+
+  FileCount := Cfg.GetValue('OtherFiles/Count/Value', 0);
+  for I := 0 to FileCount-1 do
+    begin
+      s:=Cfg.GetValue('OtherFiles/FileName'+IntToStr(I)+'/Value','');
+      OtherFiles.Add(s);
+    end;
+
+  WinCount:= Cfg.GetValue('Windows/Count/Value', 0);
+  for i:=0 To WinCount-1 do
+    begin
+      win:=TCHMWindow.Create;
+      win.loadfromxml(cfg,'Windows/item'+inttostr(i)+'/');
+      fwindows.add(win);
+    end;
+
+  Mergefilecount:=Cfg.getValue('MergeFiles/Count/Value', 0);
+  for i:=0 To MergeFileCount-1 do
+    Mergefiles.add(Cfg.getValue('MergeFiles/FileName'+IntToStr(I)+'/value',''));
+
+  // load some values that changed key backwards compatible.
+
   IndexFileName := Cfg.GetValue('Files/IndexFile/Value','');
+  if IndexFileName='' Then
+    IndexFileName := Cfg.GetValue('Settings/IndexFile/Value','');
+
   TableOfContentsFileName := Cfg.GetValue('Files/TOCFile/Value','');
+  If TableOfContentsFileName='' then
+    TableOfContentsFileName := Cfg.GetValue('Settings/TOCFile/Value','');
+
   // For chm file merging, bintoc must be false and binindex true. Change defaults in time?
-  MakeBinaryTOC := Cfg.GetValue('Files/MakeBinaryTOC/Value', True);
-  MakeBinaryIndex:= Cfg.GetValue('Files/MakeBinaryIndex/Value', False);
+  // OTOH, merging will be mostly done for fpdoc files, and that doesn't care about defaults.
+
+  S:=Cfg.GetValue('Files/MakeBinaryTOC/Value', '');
+  if s='' Then
+    MakeBinaryTOC := Cfg.GetValue('Settings/MakeBinaryTOC/Value', True)
+  else
+    MakeBinaryTOC := Cfg.GetValue('Files/MakeBinaryTOC/Value', True);
+
+  S:=Cfg.GetValue('Files/MakeBinaryIndex/Value', '');
+  if s='' Then
+    MakeBinaryIndex := Cfg.GetValue('Settings/MakeBinaryIndex/Value', False)
+  else
+    MakeBinaryIndex := Cfg.GetValue('Files/MakeBinaryIndex/Value', False);
+
   AutoFollowLinks := Cfg.GetValue('Settings/AutoFollowLinks/Value', False);
   MakeSearchable := Cfg.GetValue('Settings/MakeSearchable/Value', False);
   DefaultPage := Cfg.GetValue('Settings/DefaultPage/Value', '');
   Title := Cfg.GetValue('Settings/Title/Value', '');
   OutputFileName := Cfg.GetValue('Settings/OutputFileName/Value', '');
-  DefaultFont := Cfg.GetValue('Settings/DefaultFont/Value', '');
+  DefaultFont  := Cfg.GetValue('Settings/DefaultFont/Value', '');
+  DefaultWindow:= Cfg.GetValue('Settings/DefaultWindow/Value', '');
+  ScanHtmlContents:=  Cfg.GetValue('Settings/ScanHtmlContents/Value', False);
+
   Cfg.Free;
 end;
 
+function cleanupstring(const s:string):string;
+var
+  i:integer;
+begin
+  i:=pos(';',s);
+  if i>0 then
+    result:=trim(copy(s,1,i-1))
+  else
+    result:=trim(s);
+end;
+
+procedure TChmProject.LoadFromhhp (AFileName:String;LeaveInclude:Boolean);
+// leaveinclude=true leaves includefiles includefiles.
+
+procedure addalias(const key,value :string);
+
+var i,j : integer;
+    node: TCHMContextNode;
+    keyupper : string;
+begin
+ { Defaults other than global }
+   MakeBinaryIndex:=True;
+
+ {$ifdef hhp_debug}
+   writeln('alias entry:',key,'=',value);
+ {$endif}
+ keyupper:=uppercase(value);
+ i:=0; j:=files.count;
+ while (i<j) and (uppercase(TCHMContextnode(files.objects[i]).UrlName)<>keyupper) do
+  inc(i);
+ if i=j then
+  begin
+   {$ifdef hhp_debug}
+    writeln('alias new node:',key);
+   {$endif}
+    node:=TCHMContextNode.create;
+    node.URLName:=value;
+    node.contextname:=key;
+  end
+ else
+  begin
+    node:=TCHMContextNode(Files.objects[i]);
+    node.ContextName:=key;
+  end;
+end;
+
+procedure processalias(strs:TStringlist);
+var i,j : integer;
+    s : string;
+    strls2:tstringlist;
+
+begin
+ for i:=0 to strs.count-1 do
+  begin
+    s:=cleanupstring(strs[i]);
+    if uppercase(copy(s,1,8))='#INCLUDE' then
+      begin
+        delete(s,1,8);
+        s:=trim(s);
+        if fileexists(s) then
+          begin
+            strls2:=TstringList.create;
+            strls2.loadfromfile(s);
+            processalias(strls2);
+            strls2.free;
+          end;
+
+      end
+    else
+     begin
+       s:=cleanupstring(s);
+       j:=pos('=',s);
+       if j>0 then
+         addalias(trim(copy(s,1,j-1)),copy(s,j+1,length(s)-j));
+     end;
+  end;
+end;
+
+procedure addmap(const key,value :string);
+
+var i,j : integer;
+    node: TCHMContextNode;
+    keyupper : string;
+begin
+ {$ifdef hhp_debug}
+ writeln('map entry:',key,'=',value);
+ {$endif}
+ keyupper:=uppercase(key);
+ i:=0; j:=files.count;
+ while (i<j) and (uppercase(TCHMContextnode(files.objects[i]).contextname)<>keyupper) do
+  inc(i);
+ if i=j then
+    raise Exception.create('context "'+key+'" not found!')
+ else
+  begin
+    node:=TCHMContextNode(Files.objects[i]);
+    node.Contextnumber:=strtointdef(value,0);
+  end;
+end;
+
+procedure processmap(strs:TStringlist);
+var i,j : integer;
+    s : string;
+    strls2:tstringlist;
+
+begin
+ for i:=0 to strs.count-1 do
+  begin
+    s:=cleanupstring(strs[i]);
+    {$ifdef hhp_debug}
+      writeln('map item:',s);
+    {$endif}
+    if uppercase(copy(s,1,8))='#INCLUDE' then
+      begin
+        delete(s,1,8);
+        s:=trim(s);
+        if fileexists(s) then
+          begin
+            strls2:=TstringList.create;
+            strls2.loadfromfile(s);
+            processmap(strls2);
+            strls2.free;
+          end;
+      end
+    else
+     begin
+       s:=cleanupstring(s);
+       if uppercase(copy(s,1,7))='#DEFINE' Then
+         begin
+           delete(s,1,7);
+           s:=trim(s);
+           j:=pos(' ',s);
+           if j>0 then
+             addmap(trim(copy(s,1,j-1)),copy(s,j+1,length(s)-j));
+         end
+       else
+         begin
+            {$ifdef hhp_debug}
+              writeln('map leftover:',s);
+            {$endif}
+         end;
+     end;
+  end;
+end;
+
+var
+  Fini      : TMemIniFile;  // TMemInifile is more compatible with Delphi. Delphi's API based TIniFile fails on .hhp files.
+  secs,strs : TStringList;
+  i,j       : Integer;
+  section   : TSectionEnum;
+  nd        : TChmContextNode;
+
+begin
+  Fini:=TMeminiFile.Create(AFileName);
+  secs := TStringList.create;
+  strs := TStringList.create;
+  fini.readsections(secs);
+
+  // Do the files section first so that we can emit errors if
+  // other sections reference unknown files.
+
+  fini.readsectionvalues(SectionNames[secFiles] ,strs);
+  if strs.count>0 then
+    for j:=0 to strs.count-1 do
+      begin
+          nd:=TChmContextNode.Create;
+          nd.urlname:=strs[j];
+          nd.contextnumber:=0;
+          nd.contextname:='';
+          Files.AddObject(nd.urlname,nd);
+        end;
+
+  // aliases also add file nodes.
+
+  fini.readsectionvalues(SectionNames[secAlias] ,strs); // resolve all aliases.
+  if strs.count>0 then
+    processalias(strs);
+
+  // map files only add to existing file nodes.
+  fini.readsectionvalues(SectionNames[secmap] ,strs);
+  if strs.count>0 then
+    processmap(strs);
+
+
+  for i:=0 to secs.count-1 do
+    begin
+      section:=FindSectionName(Uppercase(Secs[i]));
+      if section<>secunknown then
+        fini.readsectionvalues(secs[i] ,strs);
+      case section of
+      secOptions   : readinioptions(strs);
+      secWindows   : for j:=0 to strs.count-1 do
+                       FWindows.add(TCHMWindow.Create(strs[j]));
+      secFiles     : ; // already done
+      secMergeFiles: FMergeFiles.Assign(Strs); // just a filelist
+      secAlias     : ; // already done
+      secMap       : ; // already done
+      secInfoTypes : ; // unused for now.
+      secTextPopups: ; // rarely used.
+      end;
+    end;
+  secs.free;
+  strs.free;
+  fini.free;
+  ScanHtmlContents:=true;
+end;
+
 procedure TChmProject.AddFileWithContext(contextid:integer;filename:ansistring;contextname:ansistring='');
 var x : integer;
     nd : TChmContextNode;
@@ -247,16 +626,41 @@ begin
         Cfg.SetValue('Files/FileName'+IntToStr(I)+'/ContextName', nd.contextname);
       end;
   end;
-  Cfg.SetValue('Files/IndexFile/Value', IndexFileName);
-  Cfg.SetValue('Files/TOCFile/Value', TableOfContentsFileName);
-  Cfg.SetValue('Files/MakeBinaryTOC/Value',MakeBinaryTOC);
-  Cfg.SetValue('Files/MakeBinaryIndex/Value',MakeBinaryIndex);
+
+  Cfg.SetValue('OtherFiles/Count/Value', OtherFiles.Count);
+  for I := 0 to OtherFiles.Count-1 do
+    Cfg.SetValue('OtherFiles/FileName'+IntToStr(I)+'/Value', OtherFiles.Strings[I]);
+
+
+  Cfg.SetValue('Windows/Count/Value', FWindows.count);
+  for i:=0 To FWindows.Count-1 do
+    TCHMWindow(FWindows[i]).savetoxml(cfg,'Windows/item'+inttostr(i)+'/');
+
+  Cfg.SetValue('MergeFiles/Count/Value', FMergeFiles.count);
+  for i:=0 To FMergeFiles.Count-1 do
+    Cfg.SetValue('MergeFiles/FileName'+IntToStr(I)+'/value',FMergeFiles[i]);
+
+  // delete legacy keys.
+  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);
+  Cfg.SetValue('Settings/MakeBinaryIndex/Value',MakeBinaryIndex);
+
   Cfg.SetValue('Settings/AutoFollowLinks/Value', AutoFollowLinks);
   Cfg.SetValue('Settings/MakeSearchable/Value', MakeSearchable);
   Cfg.SetValue('Settings/DefaultPage/Value', DefaultPage);
   Cfg.SetValue('Settings/Title/Value', Title);
   Cfg.SetValue('Settings/OutputFileName/Value', OutputFileName);
   Cfg.SetValue('Settings/DefaultFont/Value', DefaultFont);
+
+  Cfg.SetValue('Settings/DefaultWindow/Value', DefaultWindow);
+  Cfg.SetValue('Settings/ScanHtmlContents/Value', ScanHtmlContents);
+
+
   Cfg.Flush;
   Cfg.Free;
 end;
@@ -266,6 +670,134 @@ begin
   Result := ExtractFilePath(FileName);
 end;
 
+procedure TChmProject.Error(errorkind:TChmProjectErrorKind;msg:String;detaillevel:integer=0);
+begin
+  if assigned(OnError) then
+    OnError(self,errorkind,msg,detaillevel);
+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;
+  ext : String;
+begin
+ filelist:= TStringList.create;
+ localfilelist:= TStringList.create;
+
+ for j:=0 to Files.count-1 do
+   begin
+     fn:=files[j];
+     localfilelist.clear;
+     if (FAllowedExtensions.Indexof(uppercase(extractfileext(fn)))<>-1) then
+       begin
+         if fileexists(fn) then
+           begin
+             domdoc:=THtmlDocument.Create;
+             try
+               Error(chmnote,'Scanning file '+fn+'.',5);
+               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,1);
+                     end
+                   else
+                     begin
+                       Error(ChmWarning,'Found file '+s+' while scanning '+fn+', but couldn''t find it on disk',2);
+                     end
+                 end;
+             except
+               on e:exception do
+                  Error(ChmError,'Html parsing '+fn+', failed. Please submit a bug.');
+               end;
+             domdoc.free;
+           end
+         else
+           begin
+             Error(chmnote,'Can''t find file '+fn+' to scan it.',5);
+           end;
+        end
+     else
+       Error(chmnote,'Not scanning file because of unknown extension '+fn,5);
+   end;
+ if filelist.count>0 then
+   for i:=0 to filelist.count-1 do
+     begin
+       if otherfiles.indexof(filelist[i])=-1 then
+         begin
+           otherfiles.add(filelist[i]);
+           Error(chmnote,'Added media file '+filelist[i],5);
+         end
+       else
+         Error(chmnote,'Ignored duplicate found file '+filelist[i],5);
+     end;
+ filelist.free;
+ localfilelist.free;
+end;
+
 procedure TChmProject.WriteChm(AOutStream: TStream);
 var
   Writer     : TChmWriter;
@@ -274,6 +806,11 @@ var
   nd         : TChmContextNode;
   I          : Integer;
 begin
+  // Scan html for "rest" files.
+
+  If ScanHtmlContents Then
+    ScanHtml;                 // Since this is slowing we opt to skip this step, and only do this on html load.
+
   IndexStream := nil;
   TOCStream := nil;
 
@@ -283,9 +820,13 @@ begin
   Writer.OnGetFileData := @GetData;
   Writer.OnLastFile    := @LastFileAdded;
 
-  // give it the list of files
+  // give it the list of html files
   Writer.FilesToCompress.AddStrings(Files);
 
+  // give it the list of other files
+
+  Writer.FilesToCompress.AddStrings(OtherFiles);
+
   // now some settings in the chm
   Writer.DefaultPage := DefaultPage;
   Writer.Title := Title;
@@ -293,15 +834,24 @@ 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;
 
   // and write!
+
+  Error(chmnone,'Writing CHM '+OutputFileName,0);
+
   Writer.Execute;
 
   if Assigned(TOCStream) then TOCStream.Free;

packages/chm/src/chmls.lpr

@@ -27,25 +27,67 @@ program chmls;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, chmreader, chmbase, Sysutils
-  { add your units here };
+  Classes, GetOpts, SysUtils, Types,
+  chmreader, chmbase;
+
 type
 
   { TJunkObject }
 
   TJunkObject = class
+    Section  : Integer;
+    count    : integer;
+    donotpage: boolean;
     procedure OnFileEntry(Name: String; Offset, UncompressedSize, ASection: Integer);
   end;
-  
+
+  TCmdEnum = (cmdList,cmdExtract,cmdNone);        // One dummy element at the end avoids rangecheck errors.
+
+Const
+  CmdNames : array [TCmdEnum] of String = ('LIST','EXTRACT','');
 
 var
-  ITS: TITSFReader;
-  Stream: TFileStream;
-  I : Integer;
-  Section: Integer = -1;
-  JunkObject: TJunkObject;
+  theopts : array[1..2] of TOption;
+
+
+Procedure Usage;
+
+begin
+  Writeln(StdErr,'Usage: chmls [switches] [command] [command specific parameters]');
+  writeln(stderr);
+  writeln(stderr,'Switches : ');
+  writeln(stderr,' -h, --help  : this screen');
+  writeln(stderr,' -n          : do not page list output');
+  writeln(stderr);
+  writeln(stderr,'Where command is one of the following or if omitted, equal to LIST.');
+  writeln(stderr,' list     <filename> [section number] ');
+  writeln(stderr,'            Shows contents of the archive''s directory');
+  writeln(stderr,' extract  <chm filename> <filename to extract> [saveasname]');
+  writeln(stderr,'            Extracts file "filename to get" from archive "filename",');
+  writeln(stderr,'            and, if specified, saves it to [saveasname]');
+  Halt(1);
+end;
+
+procedure InitOptions;
+begin
+  with theopts[1] do
+   begin
+    name:='help';
+    has_arg:=0;
+    flag:=nil;
+    value:=#0;
+  end;
+  with theopts[2] do
+   begin
+    name:='';
+    has_arg:=0;
+    flag:=nil;
+  end;
+end;
 
-procedure WriteStr(Str: String; CharWidth: Integer);
+procedure WriteStrAdj(Str: String; CharWidth: Integer);
+// Changed to WriteStrADJ (for adjust), since 2.4.0 writestr is a builtin
+// Why doesn't Write() allow left aligned columns?, sigh.
   var
     OutString: String;
     Len: Integer;
@@ -53,8 +95,7 @@ procedure WriteStr(Str: String; CharWidth: Integer);
     Len := Length(Str);
     SetLength(OutString, CharWidth-Len);
     FillChar(OutString[1], CharWidth-Len, ' ');
-
-    Write(OutString + Str); // to sdtout
+    Write(OutString + Str); // to stdout
   end;
 
 { TJunkObject }
@@ -62,50 +103,190 @@ procedure WriteStr(Str: String; CharWidth: Integer);
 procedure TJunkObject.OnFileEntry(Name: String; Offset, UncompressedSize,
   ASection: Integer);
 begin
-  Inc(I);
+  Inc(Count);
   if (Section > -1) and (ASection <> Section) then Exit;
-  if (I = 1) or (I mod 40 = 0) then
+  if (Count = 1) or ((Count mod 40 = 0) and not donotpage) then
     WriteLn(StdErr, '<Section> <Offset> <UnCompSize>  <Name>');
   Write(' ');
   Write(ASection);
   Write('      ');
-  WriteStr(IntToStr(Offset), 10);
+  WriteStrAdj(IntToStr(Offset), 10);
   Write('  ');
-  WriteStr(IntToStr(UncompressedSize), 11);
+  WriteStrAdj(IntToStr(UncompressedSize), 11);
   Write('  ');
   WriteLn(Name);
 end;
 
-Procedure Usage;
+var donotpage:boolean=false;
 
-begin
-  WriteLn('   Usage:  chmls filename.chm [section number]');
-  Halt(1);
-end;
+procedure ListChm(Const Name:string;Section:Integer);
+var
+  ITS: TITSFReader;
+  Stream: TFileStream;
+  JunkObject: TJunkObject;
 
-// Start of program
 begin
-  if (Paramcount < 1) or (Paramstr(1)='-h') or (Paramstr(1)='-?') then 
+  if not Fileexists(name) then
     begin
-    usage;
+      writeln(stderr,' Can''t find file ',name);
+      halt(1);
     end;
-  if ParamCount > 1 then 
-    begin
-    Section := StrToIntDef(ParamStr(2),-1);
-    If (Section=-1) then
-      begin
-      Usage;
-      Halt(1);
-      end;
-    end; 
-  Stream := TFileStream.Create(ParamStr(1), fmOpenRead);
+
+  Stream := TFileStream.Create(name, fmOpenRead);
   JunkObject := TJunkObject.Create;
+  JunkObject.Section:=Section;
+  JunkObject.Count:=0;
+  JunkObject.DoNotPage:=DoNotPage;
+
   ITS:= TITSFReader.Create(Stream, True);
-  I := 0;
   ITS.GetCompleteFileList(@JunkObject.OnFileEntry);
-  
-  WriteLn('Total Files in chm: ', I);
+
+  WriteLn('Total Files in chm: ', JunkObject.Count);
   ITS.Free;
   JunkObject.Free;
+end;
+
+procedure ExtractFile(chm,readfrom,saveto:string);
+var
+  fs: TFileStream;
+  m : TMemoryStream;
+  r : TChmReader;
+begin
+  if not Fileexists(chm) then
+    begin
+      writeln(stderr,' Can''t find file ',chm);
+      halt(1);
+    end;
+
+  if (length(readfrom)>1) and (readfrom[1]<>'/') then
+    readfrom:='/'+readfrom;
+
+  fs:=TFileStream.create(chm,fmOpenRead);
+  r:=TChmReader.Create(fs,True);
+  m:=r.getobject(readfrom);
+  if assigned(m) then
+    begin
+      try
+        Writeln('Extracting ms-its:/',chm,'::',readfrom,' to ',saveto);
+        m.savetofile(saveto);
+      except
+        on e : exception do
+          writeln('Can''t write to file ',saveto);
+        end;
+     end
+  else
+    begin
+      writeln(stderr,'Can''t find file ',readfrom,' in ',chm);
+      halt(1);
+    end;
+end;
+
+procedure buildarglist(var params: TStringDynArray;var cmd :TCmdEnum);
+
+var s           : ansistring;
+    j,k         : Integer;
+
+begin
+  s:=uppercase(paramstr(optind));
+  cmd:=Low(TCMDEnum);
+  While (cmd<>high(TCmdEnum)) and (s<>CmdNames[cmd]) do
+    inc(cmd);
+  if cmd=CmdNone then
+    begin
+      writeln(stderr,' Using cmdls without command is deprecated, this may be removed in a future version');
+      writeln(stderr,' Please consider using the "list" command');
+      cmd:=CmdList;      // no cmd found -> list  In the future we can also do a name check here for the default (symlink on unix)
+      k:=optind;
+    end
+  else
+    begin
+      k:=optind+1;
+    end;
+  setlength(params,paramcount-k+1);
+  for j:=k to paramcount do
+    params[j-k]:=paramstr(j);
+end;
+
+Var
+  LocalParams : TStringDynArray;
+  c:   char;
+  i,
+  Params,
+  OptionIndex : Longint;
+  cmd         : TCmdEnum;
+  section     : Integer = -1;
+
+// Start of program
+begin
+  InitOptions;
+  Writeln(stderr,'chmls, a CHM utility. (c) 2010 Free Pascal core.');
+  Writeln(Stderr);
+  repeat
+    c:=getlongopts('hn',@theopts[1],optionindex);
+    case c of
+      #0 : begin
+             case optionindex-1 of
+               0 : begin;
+                     Usage;
+                     Halt;
+                   end;
+                end;
+           end;
+      'n'     : donotpage:=true;
+      '?','h' :
+            begin
+              writeln('unknown option',optopt);
+              usage;
+              halt;
+            end;
+   end; { case }
+ until c=endofoptions;
+
+ params:=Paramcount-optind+1;
+
+ if params>0 then
+  begin
+    BuildArgList(localparams,cmd);
+    case cmd of
+      cmdlist : begin
+                  case length(localparams) of
+                    1 : ListChm(localparams[0],Section);
+                    2 : begin
+                          if not TryStrToInt(localparams[1],section) then
+                            begin
+                              writeln(stderr,' Invalid value for section ',localparams[2]);
+                              usage;
+                              halt(1);
+                            end;
+                          ListChm(localparams[0],Section);
+                        end;
+                  else
+                    begin
+                      writeln(stderr,' Wrong number of parameters for LIST ',length(localparams));
+                      usage;
+                      halt(1);
+                    end
+                   end; {case}
+                end; { cmdlist}
+      cmdextract : begin
+                     case length(localparams) of
+                      2: ExtractFile(localparams[0],localparams[1],extractfilename(localparams[1]));
+                      3: ExtractFile(localparams[0],localparams[1],localparams[2]);
+                     else
+                      begin
+                        writeln(stderr,' Wrong number of parameters for LIST ',length(localparams));
+                        usage;
+                        halt(1);
+                      end
+                     end;
+                   end;
+      end; {case cmd of}
+  end
+ else
+   begin
+     Usage;
+     halt;
+   end;
+
 end.
 

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);
@@ -54,25 +54,26 @@ type
   protected
     fStream: TStream;
     fFreeStreamOnDestroy: Boolean;
-    fChmHeader: TITSFHeader;
+    fITSFHeader: TITSFHeader;
     fHeaderSuffix: TITSFHeaderSuffix;
     fDirectoryHeader: TITSPHeader;
     fDirectoryHeaderPos: QWord;
     fDirectoryHeaderLength: QWord;
     fDirectoryEntriesStartPos: QWord;
-    fDirectoryEntries: array of TPMGListChunkEntry;
     fCachedEntry: TPMGListChunkEntry; //contains the last entry found by ObjectExists
     fDirectoryEntriesCount: LongWord;
+    procedure ReadHeader; virtual;
+    procedure ReadHeaderEntries; virtual;
+    function  GetChunkType(Stream: TMemoryStream; ChunkIndex: LongInt): TDirChunkType;
+    procedure GetSections(out Sections: TStringList);
   private
-    procedure ReadHeader;
-    function  GetChunkType(Stream: TMemoryStream; ChunkIndex: LongInt): TPMGchunktype;
     function  GetDirectoryChunk(Index: Integer; OutStream: TStream): Integer;
     function  ReadPMGLchunkEntryFromStream(Stream: TMemoryStream; var PMGLEntry: TPMGListChunkEntry): Boolean;
     function  ReadPMGIchunkEntryFromStream(Stream: TMemoryStream; var PMGIEntry: TPMGIIndexChunkEntry): Boolean;
     procedure LookupPMGLchunk(Stream: TMemoryStream; out PMGLChunk: TPMGListChunk);
     procedure LookupPMGIchunk(Stream: TMemoryStream; out PMGIChunk: TPMGIIndexChunk);
 
-    procedure GetSections(out Sections: TStringList);
+
     function  GetBlockFromSection(SectionPrefix: String; StartPos: QWord; BlockLength: QWord): TMemoryStream;
     function  FindBlocksFromUnCompressedAddr(var ResetTableEntry: TPMGListChunkEntry;
        out CompressedSize: QWord; out UnCompressedSize: QWord; out LZXResetTable: TLZXResetTableArr): QWord;  // Returns the blocksize
@@ -82,13 +83,13 @@ type
   public
     ChmLastError: LongInt;
     function IsValidFile: Boolean;
-    procedure GetCompleteFileList(ForEach: TFileEntryForEach);
-    function ObjectExists(Name: String): QWord; // zero if no. otherwise it is the size of the object
+    procedure GetCompleteFileList(ForEach: TFileEntryForEach; AIncludeInternalFiles: Boolean = True); virtual;
+    function ObjectExists(Name: String): QWord; virtual; // zero if no. otherwise it is the size of the object
                                                 // NOTE directories will return zero size even if they exist
-    function GetObject(Name: String): TMemoryStream; // YOU must Free the stream
+    function GetObject(Name: String): TMemoryStream; virtual; // YOU must Free the stream
     property CachedEntry: TPMGListChunkEntry read fCachedEntry;
   end;
-  
+
   { TChmReader }
 
   TChmReader = class(TITSFReader)
@@ -104,12 +105,16 @@ type
     fURLTBLStream,
     fStringsStream: TMemoryStream;
     fLocaleID: DWord;
+    fWindowsList : 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;
@@ -127,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 fWindowsList;
+    property DefaultWindow : string read fdefaultwindow;
   end;
 
   { TChmFileList }
@@ -156,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;
@@ -164,7 +171,7 @@ const
   ERR_NOT_SUPPORTED_VERSION = 2;
   ERR_NOT_VALID_FILE = 3;
   ERR_UNKNOWN_ERROR = 10;
-  
+
   function ChmErrorToStr(Error: Integer): String;
 
 implementation
@@ -181,7 +188,7 @@ begin
   end;
 end;
 
-function ChunkType(Stream: TMemoryStream): TPMGchunktype;
+function ChunkType(Stream: TMemoryStream): TDirChunkType;
 var
   ChunkID: array[0..3] of char;
 begin
@@ -189,39 +196,46 @@ begin
   if Stream.Size< 4 then exit;
   Move(Stream.Memory^, ChunkId[0], 4);
   if ChunkID = 'PMGL' then Result := ctPMGL
-  else if ChunkID = 'PMGI' then Result := ctPMGI;
+  else if ChunkID = 'PMGI' then Result := ctPMGI
+  else if ChunkID = 'AOLL' then Result := ctAOLL
+  else if ChunkID = 'AOLI' then Result := ctAOLI;
 end;
 
 { TITSFReader }
 
 procedure TITSFReader.ReadHeader;
-var
-fHeaderEntries: array [0..1] of TITSFHeaderEntry;
 begin
-  fStream.Position := 0;
-  fStream.Read(fChmHeader,SizeOf(fChmHeader));
+  fStream.Read(fITSFHeader,SizeOf(fITSFHeader));
 
   // Fix endian issues
   {$IFDEF ENDIAN_BIG}
-  fChmHeader.Version := LEtoN(fChmHeader.Version);
-  fChmHeader.HeaderLength := LEtoN(fChmHeader.HeaderLength);
+  fITSFHeader.Version := LEtoN(fITSFHeader.Version);
+  fITSFHeader.HeaderLength := LEtoN(fITSFHeader.HeaderLength);
   //Unknown_1
-  fChmHeader.TimeStamp := BEtoN(fChmHeader.TimeStamp);//bigendian
-  fChmHeader.LanguageID := LEtoN(fChmHeader.LanguageID);
-  //Guid1
-  //Guid2
+  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;
+
+procedure TITSFReader.ReadHeaderEntries;
+var
+fHeaderEntries: array [0..1] of TITSFHeaderEntry;
+begin
   // Copy EntryData into memory
   fStream.Read(fHeaderEntries[0], SizeOf(fHeaderEntries));
 
-  if fChmHeader.Version > 2 then
+  if fITSFHeader.Version = 3 then
     fStream.Read(fHeaderSuffix.Offset, SizeOf(QWord));
   fHeaderSuffix.Offset := LEtoN(fHeaderSuffix.Offset);
   // otherwise this is set in fill directory entries
-  
+
   fStream.Position := LEtoN(fHeaderEntries[1].PosFromZero);
   fDirectoryHeaderPos := LEtoN(fHeaderEntries[1].PosFromZero);
   fStream.Read(fDirectoryHeader, SizeOf(fDirectoryHeader));
@@ -408,6 +422,7 @@ procedure TChmReader.ReadCommonData;
          fDefaultPage := '/'+ReadString(fStrings);
        end;
      end;
+     ReadWindows(FWindows);
    end;
    procedure ReadContextIds;
    var
@@ -439,7 +454,7 @@ begin
    ReadFromSystem;
    ReadFromWindows;
    ReadContextIds;
-   {$IFDEF CHM_DEBUG}   
+   {$IFDEF CHM_DEBUG}
    WriteLn('TOC=',fTocfile);
    WriteLn('DefaultPage=',fDefaultPage);
    {$ENDIF}
@@ -458,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;
@@ -489,18 +511,91 @@ begin
             and (fURLTBLStream <> nil);
 end;
 
+procedure TChmReader.ReadWindows(mem:TMemoryStream);
+
+var
+  i,cnt,
+  version   : integer;
+  x         : TChmWindow;
+begin
+ if not assigned(fwindowslist) then
+ fWindowsList.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;
+
+     fWindowslist.Add(x);
+     dec(cnt);
+   end;
+end;
+
 constructor TChmReader.Create(AStream: TStream; FreeStreamOnDestroy: Boolean);
 begin
+  fContextList := TContextList.Create;
+  fWindowslist      := TObjectlist.Create(True);
+  fDefaultWindow:='';
+
   inherited Create(AStream, FreeStreamOnDestroy);
   if not IsValidFile then exit;
 
-  fContextList := TContextList.Create;
   ReadCommonData;
 end;
 
 destructor TChmReader.Destroy;
 begin
-  fContextList.Free;
+  FreeAndNil(fContextList);
+  FreeAndNil(FWindowslist);
   FreeAndNil(FSearchReader);
   FreeAndNil(fTOPICSStream);
   FreeAndNil(fURLSTRStream);
@@ -509,7 +604,7 @@ begin
   inherited Destroy;
 end;
 
-function TITSFReader.GetChunkType(Stream: TMemoryStream; ChunkIndex: LongInt): TPMGchunktype;
+function TITSFReader.GetChunkType(Stream: TMemoryStream; ChunkIndex: LongInt): TDirChunkType;
 var
   Sig: array[0..3] of char;
 begin
@@ -518,7 +613,9 @@ begin
 
   Stream.Read(Sig, 4);
   if Sig = 'PMGL' then Result := ctPMGL
-  else if Sig = 'PMGI' then Result := ctPMGI;
+  else if Sig = 'PMGI' then Result := ctPMGI
+  else if Sig = 'AOLL' then Result := ctAOLL
+  else if Sig = 'AOLI' then Result := ctAOLI;
 end;
 
 function TITSFReader.GetDirectoryChunk(Index: Integer; OutStream: TStream): Integer;
@@ -590,7 +687,7 @@ begin
 
   buf[NameLength] := #0;
   PMGIEntry.Name := buf;
-  
+
   PMGIEntry.ListingChunk := GetCompressedInteger(Stream);
   if NameLength = 0 then Exit; // failed GetCompressedInteger sanity check
   Result := True;
@@ -599,6 +696,7 @@ end;
 constructor TITSFReader.Create(AStream: TStream; FreeStreamOnDestroy: Boolean);
 begin
   fStream := AStream;
+  fStream.Position := 0;
   fFreeStreamOnDestroy := FreeStreamOnDestroy;
   ReadHeader;
   if not IsValidFile then Exit;
@@ -606,7 +704,6 @@ end;
 
 destructor TITSFReader.Destroy;
 begin
-  SetLength(fDirectoryEntries, 0);
   if fFreeStreamOnDestroy then FreeAndNil(fStream);
 
   inherited Destroy;
@@ -615,13 +712,15 @@ end;
 function TITSFReader.IsValidFile: Boolean;
 begin
   if (fStream = nil) then ChmLastError := ERR_STREAM_NOT_ASSIGNED
-  else if (fChmHeader.ITSFsig <> 'ITSF') then ChmLastError := ERR_NOT_VALID_FILE
-  else if (fChmHeader.Version <> 2) and (fChmHeader.Version <> 3) then
+  else if (fITSFHeader.ITSFsig <> 'ITSF') then ChmLastError := ERR_NOT_VALID_FILE
+  //else if (fITSFHeader.Version <> 2) and (fITSFHeader.Version <> 3)
+  else if not (fITSFHeader.Version in [2..4])
+  then
     ChmLastError := ERR_NOT_SUPPORTED_VERSION;
   Result := ChmLastError = ERR_NO_ERR;
 end;
 
-procedure TITSFReader.GetCompleteFileList(ForEach: TFileEntryForEach);
+procedure TITSFReader.GetCompleteFileList(ForEach: TFileEntryForEach; AIncludeInternalFiles: Boolean = True);
 var
   ChunkStream: TMemoryStream;
   I : Integer;
@@ -662,7 +761,12 @@ begin
          Entry.DecompressedLength := GetCompressedInteger(ChunkStream);
          if ChunkStream.Position > CutOffPoint then Break; // we have entered the quickref section
          fCachedEntry := Entry; // if the caller trys to get this data we already know where it is :)
-         ForEach(Entry.Name, Entry.ContentOffset, Entry.DecompressedLength, Entry.ContentSection);
+         if  (Length(Entry.Name) = 1)
+         or (AIncludeInternalFiles
+              or
+             ((Length(Entry.Name) > 1) and (not(Entry.Name[2] in ['#','$',':']))))
+         then
+          ForEach(Entry.Name, Entry.ContentOffset, Entry.DecompressedLength, Entry.ContentSection);
        end;
      end;
     {$IFDEF CHM_DEBUG_CHUNKS}
@@ -700,7 +804,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));
@@ -728,10 +832,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
@@ -747,10 +851,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;
@@ -766,7 +870,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;
 
@@ -777,13 +881,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);
@@ -796,7 +900,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;
@@ -808,7 +912,7 @@ begin
             CRes := ChmCompareText(Name, Entry.Name);
             if CRes = 0 then begin
               fCachedEntry := Entry;
-              Result := Entry.DecompressedLength;              
+              Result := Entry.DecompressedLength;
               Break;
             end;
             Inc(I);
@@ -841,7 +945,7 @@ begin
   end
   else begin // we have to get it from ::DataSpace/Storage/[MSCompressed,Uncompressed]/ControlData
     GetSections(SectionNames);
-    FmtStr(SectionName, '::DataSpace/Storage/%s/',[SectionNames[Entry.ContentSection-1]]);
+    FmtStr(SectionName, '::DataSpace/Storage/%s/',[SectionNames[Entry.ContentSection]]);
     Result := GetBlockFromSection(SectionName, Entry.ContentOffset, Entry.DecompressedLength);
     SectionNames.Free;
   end;
@@ -927,7 +1031,7 @@ function TChmReader.GetIndexSitemap(ForceXML:boolean=false): TChmSiteMap;
 var Index   : TMemoryStream;
     sitemap : TChmSiteMap;
     Item    : TChmSiteMapItem;
-    
+
 function  AbortAndTryTextual:tchmsitemap;
 
 begin
@@ -978,7 +1082,7 @@ begin
          litem.local:=topic;
          litem.text :=Title; // recursively split this? No examples.
        end;
-   end;  
+   end;
 end;
 
 procedure parselistingblock(p:pbyte);
@@ -1004,7 +1108,7 @@ begin
 
   tail:=p+(2048-hdr^.length);
   head:=p+sizeof(TBtreeBlockHeader);
-  
+
   {$ifdef binindex}
   writeln('previndex  : ',hdr^.IndexOfPrevBlock);
   writeln('nextindex  : ',hdr^.IndexOfNextBlock);
@@ -1084,12 +1188,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
@@ -1101,8 +1205,8 @@ begin
                 end;
              end;
             trytextual:=false;
-            result:=sitemap; 
-          end;   
+            result:=sitemap;
+          end;
     end;
   if trytextual then
     begin
@@ -1222,7 +1326,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
@@ -1235,8 +1339,6 @@ begin
     {$ENDIF}
     Sections.Add(WString);
   end;
-  // the sections are sorted alphabetically, this way section indexes will jive
-  Sections.Sort;
   Stream.Free;
 end;
 
@@ -1340,7 +1442,7 @@ begin
         ReadCount := ResetTable[X+1] - ResetTable[X];
 
       BlockWriteLength := BlockSize;
-      
+
       if FirstBlock = LastBlock then begin
         WriteCount := BlockLength;
       end
@@ -1366,7 +1468,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);
 
@@ -1486,7 +1588,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

@@ -25,7 +25,7 @@ unit chmtypes;
 interface
 
 uses
-  Classes, SysUtils;
+  Classes, SysUtils,xmlcfg;
 
 type
   TSectionName = (snMSCompressed, snUnCompressed);
@@ -91,6 +91,57 @@ 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,
+                Toc_file,
+                index_file,
+                Default_File,
+                Home_button_file,
+                Jumpbutton_1_File,
+                Jumpbutton_1_Text,
+                Jumpbutton_2_File,
+                Jumpbutton_2_Text : string;
+                nav_style    : integer;  // overlay with bitfields (next 2 also)
+                navpanewidth : integer;
+                buttons      : integer;
+                left,
+                top,
+                right,
+                bottom       : integer;
+                styleflags   ,
+                xtdstyleflags,
+                window_show_state,
+                navpane_initially_closed,
+                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;
+
+
   TTOCIdxHeader = record
     BlockSize: DWord; // 4096
     EntriesOffset: DWord;
@@ -392,5 +443,183 @@ begin
   //WriteLn(ChunkLevelCount);
 end;
 
-end.
+function getnext(const s:string;var i: integer;len:integer):string;
+var
+    ind : integer;
+
+begin
+ if i>len then exit('');
+ ind:=i;
+ if s[ind]='"' then
+   begin
+     inc(ind);
+     while (ind<=len) and (s[ind]<>'"') do inc(ind);
+     result:=copy(s,i+1,ind-i-1);
+     inc(ind); // skip "
+   end
+ else
+   begin
+     while (ind<=len) and (s[ind]<>',') do inc(ind);
+     result:=copy(s,i,ind-i);
+   end;
+ i:=ind+1; // skip ,
+end;
+
+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;
+
+procedure TCHMWindow.load_from_ini(txt:string);
+var ind,len,
+    j,k     : integer;
+    arr     : array[0..3] of integer;
+    s2      : string;
+begin
+  flags:=[];
+  j:=pos('=',txt);
+  if j>0 then
+    txt[j]:=',';
+  ind:=1; len:=length(txt);
+  window_type       :=getnext(txt,ind,len);
+  Title_bar_text    :=getnext(txt,ind,len);
+  index_file        :=getnext(txt,ind,len);
+  Toc_file          :=getnext(txt,ind,len);
+  Default_File      :=getnext(txt,ind,len);
+  Home_button_file  :=getnext(txt,ind,len);
+  Jumpbutton_1_File :=getnext(txt,ind,len);
+  Jumpbutton_1_Text :=getnext(txt,ind,len);
+  Jumpbutton_2_File :=getnext(txt,ind,len);
+  Jumpbutton_2_Text :=getnext(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);
+  left  :=arr[0];
+  top   :=arr[1];
+  right :=arr[2];
+  bottom:=arr[3];
+  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);
+begin
+  cfg.setvalue(key+'window_type',window_type);
+  cfg.setvalue(key+'title_bar_text',title_bar_text);
+  cfg.setvalue(key+'toc_file',   Toc_file  );
+  cfg.setvalue(key+'index_file',   index_file  );
+  cfg.setvalue(key+'default_file',   Default_File    );
+  cfg.setvalue(key+'home_button_file',   Home_button_file);
+  cfg.setvalue(key+'jumpbutton_1_file',   Jumpbutton_1_File     );
+  cfg.setvalue(key+'jumpbutton_1_text',   Jumpbutton_1_Text     );
+  cfg.setvalue(key+'jumpbutton_2_file',   Jumpbutton_2_File   );
+  cfg.setvalue(key+'jumpbutton_2_text',   Jumpbutton_2_Text     );
+  cfg.setvalue(key+'nav_style',   nav_style );
+  cfg.setvalue(key+'navpanewidth',   navpanewidth    );
+  cfg.setvalue(key+'buttons',   buttons   );
+  cfg.setvalue(key+'left',   left);
+  cfg.setvalue(key+'top',   top );
+  cfg.setvalue(key+'right',   right     );
+  cfg.setvalue(key+'bottom',   bottom    );
+  cfg.setvalue(key+'styleflags',   styleflags);
+  cfg.setvalue(key+'xtdstyleflags',   xtdstyleflags   );
+  cfg.setvalue(key+'window_show_state',   window_show_state     );
+  cfg.setvalue(key+'navpane_initially_closed',navpane_initially_closed  );
+  cfg.setvalue(key+'navpane_default',navpane_default);
+  cfg.setvalue(key+'navpane_location',navpane_location    );
+  cfg.setvalue(key+'wm_notify_id',wm_notify_id  );
+end;
+
+procedure TCHMWindow.loadfromxml(cfg:TXMLConfig;key:string);
+
+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','');
+  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','');
+  Jumpbutton_1_Text     :=cfg.getvalue(key+'jumpbutton_1_text','');
+  Jumpbutton_2_File     :=cfg.getvalue(key+'jumpbutton_2_file','');
+  Jumpbutton_2_Text     :=cfg.getvalue(key+'jumpbutton_2_text','');
+  nav_style             :=cfg.getvalue(key+'nav_style',0);
+  navpanewidth          :=cfg.getvalue(key+'navpanewidth',0);
+  buttons               :=cfg.getvalue(key+'buttons',0);
+  left                  :=cfg.getvalue(key+'left',0);
+  top                   :=cfg.getvalue(key+'top',0);
+  right                 :=cfg.getvalue(key+'right',0);
+  bottom                :=cfg.getvalue(key+'bottom',0);
+  styleflags            :=cfg.getvalue(key+'styleflags',0);
+  xtdstyleflags         :=cfg.getvalue(key+'xtdstyleflags',0);
+  window_show_state     :=cfg.getvalue(key+'window_show_state',0);
+  navpane_initially_closed :=cfg.getvalue(key+'navpane_initially_closed',0);
+  navpane_default       :=cfg.getvalue(key+'navpane_default',0);
+  navpane_location      :=cfg.getvalue(key+'navpane_location',0);
+  wm_notify_id          :=cfg.getvalue(key+'wm_notify_id',0);
+end;
+
+Constructor TCHMWindow.create(s:string='');
+
+begin
+ if s<>'' then
+   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
@@ -241,8 +252,6 @@ begin
     Unknown_1 := NToLE(DWord(1));
     TimeStamp:= NToBE(MilliSecondOfTheDay(Now)); //bigendian
     LanguageID := NToLE(DWord($0409)); // English / English_US
-    Guid1 := ITSFHeaderGUID;
-    Guid2 := ITSFHeaderGUID;
   end;
 end;
 
@@ -314,6 +323,12 @@ end;
 procedure TITSFWriter.WriteHeader(Stream: TStream);
 begin
   Stream.Write(ITSFHeader, SizeOf(TITSFHeader));
+
+  if ITSFHeader.Version < 4 then
+  begin
+    Stream.Write(ITSFHeaderGUID, SizeOf(TGuid));
+    Stream.Write(ITSFHeaderGUID, SizeOf(TGuid));
+  end;
   Stream.Write(HeaderSection0Table, SizeOf(TITSFHeaderEntry));
   Stream.Write(HeaderSection1Table, SizeOf(TITSFHeaderEntry));
   Stream.Write(HeaderSuffix, SizeOf(TITSFHeaderSuffix));
@@ -897,7 +912,7 @@ begin
 
   lzx_finish(LZXdata, nil);
   {$ELSE}
-  Compressor := TLZXCompressor.Create(10);
+  Compressor := TLZXCompressor.Create(4);
   Compressor.OnChunkDone  :=@LTChunkDone;
   Compressor.OnGetData    :=@LTGetData;
   Compressor.OnIsEndOfFile:=@LTIsEndOfFile;
@@ -1002,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));
@@ -1011,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
@@ -1041,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;
@@ -1236,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;
@@ -1252,6 +1345,7 @@ begin
   WriteTOPICS;
   WriteURL_STR_TBL;
   WriteSTRINGS;
+  WriteWINDOWS;
   WriteFiftiMain;
 end;
 
@@ -1283,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;
@@ -1300,6 +1396,7 @@ begin
   FAvlUrlStr.Free;
   FAvlStrings.FreeAndClear;
   FAvlStrings.Free;
+  FWindows.Free;
 
   inherited Destroy;
 end;
@@ -1458,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);
@@ -2075,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);
@@ -2102,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.
 

packages/chm/src/lzxcompressthread.pas

@@ -249,7 +249,7 @@ begin
     FMasterThread.Resume;
     if WaitForFinish then
       While Running do
-        CheckSynchronize(50);
+        CheckSynchronize(10);
 end;
 
 { TLZXMasterThread }
@@ -263,6 +263,7 @@ function TLZXMasterThread.BlockDone(Worker: TLZXWorkerThread; ABlock: PLZXFinish
 begin
   Lock;
   REsult := True;
+
   FCompressor.BlockIsFinished(ABlock);
   if DataRemains then
     QueueThread(Worker)
@@ -349,7 +350,8 @@ begin
 
   Thread.CompressData(FBlockNumber);
   Inc(FBlockNumber);
-  Thread.Resume;
+  if Thread.Suspended then
+    Thread.Resume;
   UnLockTmpData;
 end;
 
@@ -370,7 +372,7 @@ begin
   //Suspend;
   while Working do
   begin
-      Sleep(50);
+      Sleep(0);
   end;
   FRunning:= False;
 end;
@@ -489,12 +491,16 @@ begin
   while not Terminated do
   begin
     lzx_reset(LZXdata);
+
     lzx_compress_block(LZXdata, WSize, True);
 
     MasterThread.Synchronize(@NotifyMasterDone);
 
     if ShouldSuspend then
+    begin
       Suspend;
+    end;
+
   end;
 end;
 

packages/chm/src/paslzxcomp.pas

@@ -285,9 +285,8 @@ begin
 	  if (leaves[leaves_left].freq <> 1) then begin
             leaves[leaves_left].freq := leaves[leaves_left].freq shr 1;
             codes_too_long := 0;
-            Inc(leaves_left);
           end;
-
+          Inc(leaves_left);
         end;
         if codes_too_long <> 0 then
           raise Exception.Create('!codes_too_long');
@@ -994,7 +993,6 @@ begin
   Fillchar(lzxd^.length_freq_table[0], NUM_SECONDARY_LENGTHS * sizeof(longint), 0);
   Fillchar(lzxd^.main_freq_table[0], lzxd^.main_tree_size * sizeof(longint), 0);
   Fillchar(lzxd^.aligned_freq_table[0], LZX_ALIGNED_SIZE * sizeof(longint), 0);
-
   while ((lzxd^.left_in_block<>0) and ((lz_left_to_process(lzxd^.lzi)<>0) or not(lzxd^.at_eof(lzxd^.in_arg)))) do begin
     lz_compress(lzxd^.lzi, lzxd^.left_in_block);
 
@@ -1002,7 +1000,6 @@ begin
       lzxd^.left_in_frame := LZX_FRAME_SIZE;
     end;
     
-    if lzxd^.at_eof(lzxd^.in_arg) then Sleep(500);
     if ((lzxd^.subdivide<0)
       or (lzxd^.left_in_block = 0)
       or ((lz_left_to_process(lzxd^.lzi) = 0) and lzxd^.at_eof(lzxd^.in_arg))) then begin
@@ -1023,7 +1020,6 @@ begin
 	lzx_write_bits(lzxd, 1, 0);
 	lzxd^.need_1bit_header := 0;
       end;
-
       //* handle extra bits */
       uncomp_bits := 0;
       comp_bits := 0;

packages/fcl-passrc/examples/test_parser.pp

@@ -0,0 +1,61 @@
+{$mode objfpc}{$H+}
+
+uses SysUtils, Classes, PParser, PasTree;
+
+type
+  { We have to override abstract TPasTreeContainer methods.
+    See utils/fpdoc/dglobals.pp for an implementation of TFPDocEngine,
+    a "real" engine. }
+  TSimpleEngine = class(TPasTreeContainer)
+  public
+    function CreateElement(AClass: TPTreeElement; const AName: String;
+      AParent: TPasElement; AVisibility: TPasMemberVisibility;
+      const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+      override;
+    function FindElement(const AName: String): TPasElement; override;
+  end;
+
+function TSimpleEngine.CreateElement(AClass: TPTreeElement; const AName: String;
+  AParent: TPasElement; AVisibility: TPasMemberVisibility;
+  const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+begin
+  Result := AClass.Create(AName, AParent);
+  Result.Visibility := AVisibility;
+  Result.SourceFilename := ASourceFilename;
+  Result.SourceLinenumber := ASourceLinenumber;
+end;
+
+function TSimpleEngine.FindElement(const AName: String): TPasElement;
+begin
+  { dummy implementation, see TFPDocEngine.FindElement for a real example }
+  Result := nil;
+end;
+
+var
+  M: TPasModule;
+  E: TPasTreeContainer;
+  I: Integer;
+  Decls: TList;
+begin
+  if Paramcount<1 then
+    begin
+     // remember to put the whole cmdline in quotes, and
+     // to always add some path options. Even if only -Fu. -Fi.
+      writeln('usage: test_parser <commandline>');
+      halt;
+    end;
+  E := TSimpleEngine.Create;
+  try
+    M := ParseSource(E, ParamStr(1), 'linux', 'i386');
+
+    { Cool, we successfully parsed the unit.
+      Now output some info about it. }
+    Decls := M.InterfaceSection.Declarations;
+    for I := 0 to Decls.Count - 1 do
+      Writeln('Interface item ', I, ': ', (TObject(Decls[I]) as TPasElement).Name);
+
+    FreeAndNil(M);
+  finally 
+    FreeAndNil(E) 
+    end;
+end.

packages/fcl-passrc/src/pastree.pp

@@ -67,6 +67,37 @@ resourcestring
   SPasTreeDestructorImpl = 'destructor implementation';
 
 type
+  TPasExprKind = (pekIdent, pekNumber, pekString, pekSet,
+     pekPrefix, pekPostfix, pekBinary, pekFuncParams, pekArrayParams);
+
+  TExprOpCode = (eopNone,
+                 eopAdd,eopSubtract,eopMultiply,eopDivide, eopDiv,eopMod, eopPower,// arithmetic
+                 eopShr,eopSHl, // bit operations
+                 eopNot,eopAnd,eopOr,eopXor, // logical/bit
+                 eopEqual, eopNotEqual,  // Logical
+                 eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual, // ordering
+                 eopIn,eopIs,eopAs, eopSymmetricaldifference, // Specials
+                 eopAddress);
+  
+  { TPasExprPart }
+
+  TPasExprPart = class 
+    Kind      : TPasExprKind;
+    Left      : TPasExprPart;
+    Right     : TPasExprPart;
+    OpCode    : TexprOpcode;
+    Value    : AnsiString;
+    Params    : array of TPasExprPart;
+    constructor Create(AKind: TPasExprKind);
+    constructor CreateWithText(AKind: TPasExprKind; const AValue : Ansistring);
+    constructor CreatePrefix(rightExp: TPasExprPart; const AOpCode: TExprOpCode);
+    constructor CreatePostfix(leftExp: TPasExprPart; const AOpCode: TExprOpCode);
+    constructor CreateBinary(xleft, xright: TPasExprPart; const AOpCode: TExprOpCode);
+    destructor Destroy; override;
+    procedure AddParam(xp: TPasExprPart);
+  end;
+
+
   // Visitor pattern.
   TPassTreeVisitor = class;
 
@@ -436,6 +467,7 @@ type
     Value: string;
     Modifiers : string;
     AbsoluteLocation : String;
+    Expr: TPasExprPart;
   end;
 
   { TPasConst }
@@ -2283,4 +2315,60 @@ begin
   Result:=true;
 end;
 
+{ TPasExprPart }
+
+constructor TPasExprPart.Create(AKind:TPasExprKind);
+begin
+  Kind:=AKind;
+end;
+
+constructor TPasExprPart.CreateWithText(AKind:TPasExprKind;const AValue: AnsiString);
+begin
+  Create(AKind);
+  Value:=AValue;
+end;
+
+constructor TPasExprPart.CreatePrefix(rightExp: TPasExprPart; const AOpCode: TExprOpCode);
+begin
+  Create(pekPrefix);
+  right:=rightExp;
+  Opcode:=AOpCode;
+end;
+
+constructor TPasExprPart.CreatePostfix(leftExp: TPasExprPart; const AOpCode: TExprOpCode);
+begin
+  Create(pekPostfix);
+  left:=leftExp;
+  Opcode:=AOpCode;
+end;
+
+constructor TPasExprPart.CreateBinary(xleft, xright: TPasExprPart; const AOpCode: TExprOpcode);
+begin
+  Create(pekBinary);
+  left:=xleft;
+  right:=xright;
+  Opcode:=AOpCode;
+end;
+
+destructor TPasExprPart.Destroy;
+var
+  i : Integer;
+begin
+  left.Free;
+  right.Free;
+  for i:=0 to length(Params)-1 do Params[i].Free;
+  inherited Destroy;
+end;
+
+procedure TPasExprPart.AddParam(xp:TPasExprPart);
+var
+  i : Integer;
+begin
+  i:=Length(Params);
+  SetLength(Params, i+1);
+  Params[i]:=xp;
+end;
+
+
+
 end.

packages/fcl-passrc/src/pparser.pp

@@ -80,7 +80,6 @@ type
     property Column: Integer read FColumn;
   end;
 
-
 function ParseSource(AEngine: TPasTreeContainer;
   const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
 
@@ -115,12 +114,17 @@ type
     FTokenBufferSize: Integer; // maximum valid index in FTokenBuffer
     procedure ParseExc(const Msg: String);
   protected
+    function OpLevel(t: TToken): Integer;
+    Function TokenToExprOp (AToken : TToken; Const AString : String) : TExprOpCode;
     function CreateElement(AClass: TPTreeElement; const AName: String;
       AParent: TPasElement): TPasElement;overload;
     function CreateElement(AClass: TPTreeElement; const AName: String;
       AParent: TPasElement; AVisibility: TPasMemberVisibility): TPasElement;overload;
     Function IsHint(Const S : String; var AHint : TPasMemberHint) : Boolean;
     Function CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
+
+    function ParseParams(paramskind: TPasExprKind): TPasExprPart;
+    function ParseExpIdent: TPasExprPart;
   public
     Options : set of TPOptions;
     CurModule: TPasModule;
@@ -138,6 +142,7 @@ type
     function ParseComplexType(Parent : TPasElement = Nil): TPasType;
     procedure ParseArrayType(Element: TPasArrayType);
     procedure ParseFileType(Element: TPasFileType);
+    function DoParseExpression: TPasExprPart;
     function ParseExpression: String;
     function ParseCommand: String; // single, not compound command like begin..end
     procedure AddProcOrFunction(Declarations: TPasDeclarations; AProc: TPasProcedure);
@@ -181,7 +186,6 @@ type
     property CurTokenString: String read FCurTokenString;
   end;
 
-
 function TPasTreeContainer.CreateElement(AClass: TPTreeElement;
   const AName: String; AParent: TPasElement; const ASourceFilename: String;
   ASourceLinenumber: Integer): TPasElement;
@@ -635,6 +639,278 @@ begin
     Element.ElType := ParseType(nil);
 end;
 
+const
+  EndExprToken = [
+    tkEOF, tkBraceClose, tkSquaredBraceClose, tkSemicolon,
+    tkdo, tkdownto, tkelse, tkend, tkof, tkthen, tkto
+  ];
+
+
+function TPasParser.ParseParams(paramskind: TPasExprKind): TPasExprPart;
+var
+  params  : TPasExprPart;
+  p       : TPasExprPart;
+  PClose  : TToken;
+begin
+  Result:=nil;
+  if CurToken<>tkBraceOpen then Exit;
+
+  if paramskind in [pekArrayParams, pekSet] then
+    PClose:=tkSquaredBraceClose
+  else
+    PClose:=tkBraceClose;
+
+  params:=TPasExprPart.Create(paramskind);
+  try
+    NextToken;
+    if not (CurToken in EndExprToken) then begin
+      repeat
+        p:=DoParseExpression;
+        if not Assigned(p) then Exit; // bad param syntax
+        params.AddParam(p);
+
+        if not (CurToken in [tkComma, PClose]) then begin
+          Exit;
+        end;
+
+        if CurToken = tkComma then begin
+          NextToken;
+          if CurToken = PClose then begin
+            //ErrorExpected(parser, 'identifier');
+            Exit;
+          end;
+        end;
+      until CurToken=PClose;
+    end;
+    NextToken;
+    Result:=params;
+  finally
+    if not Assigned(Result) then params.Free;
+  end;
+end;
+
+Function TPasParser.TokenToExprOp (AToken : TToken; Const AString : String) : TExprOpCode;
+
+begin
+  Case AToken of
+    tkMul                   : Result:=eopMultiply;
+    tkPlus                  : Result:=eopAdd;
+    tkMinus                 : Result:=eopSubtract;
+    tkDivision              : Result:=eopDivide;
+    tkLessThan              : Result:=eopLessThan;
+    tkEqual                 : Result:=eopEqual;
+    tkGreaterThan           : Result:=eopGreaterThan;
+    tkAt                    : Result:=eopAddress;
+    tkNotEqual              : Result:=eopNotEqual;
+    tkLessEqualThan         : Result:=eopLessthanEqual;
+    tkGreaterEqualThan      : Result:=eopGreaterThanEqual;
+    tkPower                 : Result:=eopPower;
+    tkSymmetricalDifference : Result:=eopSymmetricalDifference;                                                                                              
+    tkIs                    : Result:=eopIs;
+    tkAs                    : Result:=eopAs;
+    tkSHR                   : Result:=eopSHR;
+    tkSHL                   : Result:=eopSHL;
+    tkAnd                   : Result:=eopAnd;
+    tkOr                    : Result:=eopOR;
+    tkXor                   : Result:=eopXOR;
+    tkMod                   : Result:=eopMod;
+    tkDiv                   : Result:=eopDiv;
+    tkNot                   : Result:=eopNot;
+    tkIn                    : Result:=eopIn;
+  else
+    Raise Exception.CreateFmt('Not an operand: (%d : %s)',[AToken,Astring]);   
+  end;
+end;
+ 
+function TPasParser.ParseExpIdent:TPasExprPart;
+var
+  x, t    : TPasExprPart;
+  eofid   : Boolean;
+begin
+  Result:=nil;
+  eofid:=True;
+  case CurToken of
+    tkString: begin
+      x:=TPasExprPart.CreateWithText(pekString, CurTokenString);
+      NextToken;
+    end;
+    tkNumber:
+    begin
+      x:=TPasExprPart.CreateWithText(pekNumber, CurTokenString);
+      NextToken;
+    end;
+    tkSquaredBraceOpen:
+      x:=ParseParams(pekSet);
+    tkIdentifier: begin
+      x:=TPasExprPart.CreateWithText(pekIdent, CurTokenText);
+      eofid:=False;
+    end;
+  end;
+
+  if eofid then begin
+    Result:=x;
+    Exit;
+  end;
+
+  try
+    NextToken;
+    while CurToken in [tkBraceOpen, tkSquaredBraceOpen, tkCaret] do
+      case CurToken of
+        tkBraceOpen: begin
+          t:=ParseParams(pekFuncParams);
+          if not Assigned(t) then Exit;
+          t.left:=x;
+          x:=t;
+        end;
+        tkSquaredBraceOpen: begin
+          t:=ParseParams(pekArrayParams);
+          if not Assigned(t) then Exit;
+          t.left:=x;
+          x:=t;
+        end;
+        tkCaret: begin
+          t:=TPasExprPart.CreatePostfix(x, TokenToExprOp(CurToken,TokenInfos[CurToken]));
+          NextToken;
+          x:=t;
+        end;
+      end;
+
+    if CurToken in [tkDot, tkas] then begin
+      NextToken;
+      x:=TPasExprPart.CreateBinary(x, ParseExpIdent, TokenToExprOp(CurToken,TokenInfos[CurToken]));
+      if not Assigned(x.right) then
+        Exit; // error?
+    end;
+
+    Result:=x;
+  finally
+    if not Assigned(Result) then x.Free;
+  end;
+end;
+
+function TPasParser.OpLevel(t: TToken): Integer;
+begin
+  case t of
+    tknot,tkAt:
+      Result:=4;
+    tkMul, tkDivision, tkdiv, tkmod, tkand, tkShl,tkShr, tkas, tkPower :
+      Result:=3;
+    tkPlus, tkMinus, tkor, tkxor:
+      Result:=2;
+    tkEqual, tkNotEqual, tkLessThan, tkLessEqualThan, tkGreaterThan, tkGreaterEqualThan, tkin, tkis:
+      Result:=1;
+  else
+    Result:=0;
+  end;
+end;
+
+function TPasParser.DoParseExpression: TPasExprPart;
+var
+  expstack  : TList;
+  opstack   : TList;
+  pcount    : Integer;
+  x         : TPasExprPart;
+  i         : Integer;
+  tempop    : TToken;
+  
+const
+  PrefixSym = [tkPlus, tkMinus, tknot, tkAt]; // + - not @
+
+  function PopExp: TPasExprPart; inline;
+  begin
+    if expstack.Count>0 then begin
+      Result:=TPasExprPart(expstack[expstack.Count-1]);
+      expstack.Delete(expstack.Count-1);
+    end else
+      Result:=nil;
+  end;
+
+  procedure PushOper(token: TToken); inline;
+  begin
+    opstack.Add( Pointer(PtrInt(token)) );
+  end;
+
+  function PeekOper: TToken; inline;
+  begin
+    if opstack.Count>0 then Result:=TToken(PtrUInt(opstack[ opstack.Count-1]))
+    else Result:=tkEOF
+  end;
+
+  function PopOper: TToken; inline;
+  begin
+    Result:=PeekOper;
+    if Result<>tkEOF then opstack.Delete(opstack.Count-1);
+  end;
+
+  procedure PopAndPushOperator;
+  var
+    t       : TToken;
+    xright  : TPasExprPart;
+    xleft   : TPasExprPart;
+  begin
+    t:=PopOper;
+    xright:=PopExp;
+    xleft:=PopExp;
+    expstack.Add(TPasExprPart.CreateBinary(xleft, xright, TokenToExprOp(t,TokenInfos[t])));
+  end;
+
+begin
+  Result:=nil;
+  expstack := TList.Create;
+  opstack := TList.Create;
+  try
+    repeat
+      pcount:=0;
+      while CurToken in PrefixSym do begin
+        PushOper(CurToken);
+        inc(pcount);
+        NextToken;
+      end;
+
+      if CurToken = tkBraceOpen then begin
+        NextToken;
+        x:=DoParseExpression();
+        if CurToken<>tkBraceClose then Exit;
+        NextToken;
+      end else
+        x:=ParseExpIdent;
+
+      if not Assigned(x) then Exit;
+      expstack.Add(x);
+      for i:=1 to pcount do
+        begin
+        tempop:=PopOper;
+        expstack.Add( TPasExprPart.CreatePrefix( PopExp, TokenToExprOp(tempop,TokenInfos[tempop]) ));
+        end;
+      if not (CurToken in EndExprToken) then begin
+        // Adjusting order of the operations
+        tempop:=PeekOper;
+        while (opstack.Count>0) and (OpLevel(tempop)>=OpLevel(CurToken)) do begin
+          PopAndPushOperator;
+          tempop:=PeekOper;
+        end;
+        PushOper(CurToken);
+        NextToken;
+      end;
+
+    until CurToken in EndExprToken;
+
+    while opstack.Count>0 do PopAndPushOperator;
+
+    // only 1 expression should be on the stack, at the end of the correct expression
+    if expstack.Count=1 then Result:=TPasExprPart(expstack[0]);
+
+  finally
+    if not Assigned(Result) then begin
+      // expression error!
+      for i:=0 to expstack.Count-1 do
+        TObject(expstack[i]).Free;
+    end;
+    opstack.Free;
+    expstack.Free;
+  end;
+end;
+
 function TPasParser.ParseExpression: String;
 var
   BracketLevel: Integer;
@@ -672,7 +948,7 @@ begin
     if CurToken=tkString then
       begin
       If (Length(CurTokenText)>0) and (CurTokenText[1]=#0) then
-        Writeln('First char is null : "',CurTokenText,'"');
+        Raise Exception.Create('First char is null : "'+CurTokenText+'"');
       Result := Result + ''''+StringReplace(CurTokenText,'''','''''',[rfReplaceAll])+''''
       end
     else
@@ -1149,7 +1425,6 @@ end;
 function TPasParser.ParseConstDecl(Parent: TPasElement): TPasConst;
 begin
   Result := TPasConst(CreateElement(TPasConst, CurTokenString, Parent));
-
   try
     NextToken;
     if CurToken = tkColon then
@@ -1158,7 +1433,17 @@ begin
       UngetToken;
 
     ExpectToken(tkEqual);
-    Result.Value := ParseExpression;
+
+    //skipping the expression as a value
+    //Result.Value := ParseExpression;
+
+    // using new expression parser!
+    NextToken; // skip tkEqual
+    Result.Expr:=DoParseExpression;
+
+    // must unget for the check to be peformed fine!
+    UngetToken;
+
     CheckHint(Result,True);
   except
     Result.Free;

packages/fcl-passrc/src/pscanner.pp

@@ -986,6 +986,12 @@ begin
                 IncludeStackItem.Row := CurRow;
                 IncludeStackItem.TokenStr := TokenStr;
                 FIncludeStack.Add(IncludeStackItem);
+                if Length(Param)>1 then
+                  begin
+                    if (Param[1]=#39) and (Param[length(Param)]=#39) then
+                     param:=copy(param,2,length(param)-2);
+                  end;
+               
                 FCurSourceFile := FileResolver.FindIncludeFile(Param);
                 if not Assigned(CurSourceFile) then
                   Error(SErrIncludeFileNotFound, [Param]);