--- Merging r15640 into '.':

U    packages/chm/src/chmcmd.lpr
U    packages/chm/src/itolitlsreader.pas
--- Merging r15648 into '.':
U    packages/chm/src/chmls.lpr
--- Merging r15649 into '.':
U    packages/chm/src/chmfilewriter.pas
U    packages/chm/src/chmwriter.pas
--- Merging r15653 into '.':
G    packages/chm/src/chmls.lpr
--- Merging r15671 into '.':
U    utils/fpdoc/dwlinear.pp
--- Merging r15672 into '.':
U    packages/fcl-passrc/src/pparser.pp
--- Merging r15676 into '.':
U    packages/fcl-passrc/src/pastree.pp
U    packages/fcl-passrc/src/pscanner.pp
G    packages/fcl-passrc/src/pparser.pp
--- Merging r15687 into '.':
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/src/pscanner.pp
G    packages/fcl-passrc/src/pparser.pp

# revisions: 15640,15648,15649,15653,15671,15672,15676,15687
------------------------------------------------------------------------
r15640 | jonas | 2010-07-26 20:09:50 +0200 (Mon, 26 Jul 2010) | 2 lines
Changed paths:
   M /trunk/packages/chm/src/chmcmd.lpr
   M /trunk/packages/chm/src/itolitlsreader.pas

  * fixed range errors

------------------------------------------------------------------------
------------------------------------------------------------------------
r15648 | marco | 2010-07-27 20:30:47 +0200 (Tue, 27 Jul 2010) | 1 line
Changed paths:
   M /trunk/packages/chm/src/chmls.lpr

 * added parameter to skip filesizes etc, to easier compare chmls listings.
------------------------------------------------------------------------
------------------------------------------------------------------------
r15649 | marco | 2010-07-27 20:33:52 +0200 (Tue, 27 Jul 2010) | 1 line
Changed paths:
   M /trunk/packages/chm/src/chmfilewriter.pas
   M /trunk/packages/chm/src/chmwriter.pas

 * sitemaps now initially scanned, recursive scanning fixed.
------------------------------------------------------------------------
------------------------------------------------------------------------
r15653 | marco | 2010-07-28 16:33:50 +0200 (Wed, 28 Jul 2010) | 1 line
Changed paths:
   M /trunk/packages/chm/src/chmls.lpr

 * extractalias command, to extract the context info into alias and .h files. (request by an user)
------------------------------------------------------------------------
------------------------------------------------------------------------
r15671 | marco | 2010-07-30 19:45:32 +0200 (Fri, 30 Jul 2010) | 2 lines
Changed paths:
   M /trunk/utils/fpdoc/dwlinear.pp

 * fixed some nesting problems

------------------------------------------------------------------------
------------------------------------------------------------------------
r15672 | marco | 2010-07-30 19:51:35 +0200 (Fri, 30 Jul 2010) | 2 lines
Changed paths:
   M /trunk/packages/fcl-passrc/src/pparser.pp

 * Sergei's patch for charset constants from 17058, and a small errortext improvement from me.

------------------------------------------------------------------------
------------------------------------------------------------------------
r15676 | marco | 2010-07-31 21:28:46 +0200 (Sat, 31 Jul 2010) | 2 lines
Changed paths:
   M /trunk/packages/fcl-passrc/src/pastree.pp
   M /trunk/packages/fcl-passrc/src/pparser.pp
   M /trunk/packages/fcl-passrc/src/pscanner.pp

 * misc patches from mantis 17058, which fixes 70% of the fpdoc errors.

------------------------------------------------------------------------
------------------------------------------------------------------------
r15687 | marco | 2010-08-01 20:38:55 +0200 (Sun, 01 Aug 2010) | 2 lines
Changed paths:
   M /trunk/packages/fcl-passrc/src/pastree.pp
   M /trunk/packages/fcl-passrc/src/pparser.pp
   M /trunk/packages/fcl-passrc/src/pscanner.pp

 * mixed patches from Dmitry B, that fix the doc generation it seems.

------------------------------------------------------------------------

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

packages/chm/src/chmcmd.lpr

@@ -43,7 +43,7 @@ end;
 
 
 var
-  theopts : array[1..5] of TOption;
+  theopts : array[1..6] of TOption;
 
 procedure InitOptions;
 

packages/chm/src/chmfilewriter.pas

@@ -25,7 +25,7 @@ unit chmfilewriter;
 interface
 
 uses
-  Classes, SysUtils, chmwriter, inifiles, contnrs,
+  Strings, Classes, SysUtils, chmwriter, inifiles, contnrs, chmsitemap, avl_tree,
   {for html scanning } dom,SAX_HTML,dom_html;
 
 type
@@ -59,11 +59,17 @@ type
     fScanHtmlContents  : Boolean;
     fOtherFiles : TStrings; // Files found in a scan.
     fAllowedExtensions: TStringList;
+    fTotalFileList : TAvlTree;
+    FSpareString   : TStringIndex;
+    FBasePath       : String;     // location of the .hhp file. Needed to resolve relative paths
   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;
+    procedure ScanList(toscan,newfiles:TStrings;recursion:boolean);
+    procedure ScanSitemap(sitemap:TChmSiteMap;newfiles:TStrings;recursion:boolean);
+    function  FileInTotalList(const s:String):boolean;
   public
     constructor Create; virtual;
     destructor Destroy; override;
@@ -111,7 +117,7 @@ Const
 
 implementation
 
-uses XmlCfg, chmsitemap, CHMTypes;
+uses XmlCfg, CHMTypes;
 
 { TChmProject }
 
@@ -185,6 +191,8 @@ begin
   FWindows:=TObjectList.Create(True);
   FMergeFiles:=TStringlist.Create;
   ScanHtmlContents:=False;
+  FTotalFileList:=TAvlTree.Create(@CompareStrings);
+  FSparestring  :=TStringIndex.Create;
 end;
 
 destructor TChmProject.Destroy;
@@ -196,10 +204,12 @@ begin
   FFiles.Free;
   FOtherFiles.Free;
   FWindows.Free;
+  FSpareString.Free;
+  FTotalFileList.FreeAndClear;
+  FTotalFileList.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,
@@ -221,8 +231,6 @@ Const
        '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
@@ -303,6 +311,7 @@ begin
   Cfg := TXMLConfig.Create(nil);
   Cfg.Filename := AFileName;
   FileName := AFileName;
+  FBasePath:=extractfilepath(expandfilename(afilename));
 
   Files.Clear;
   FileCount := Cfg.GetValue('Files/Count/Value', 0);
@@ -312,7 +321,7 @@ begin
       nd.urlname:=Cfg.GetValue('Files/FileName'+IntToStr(I)+'/Value','');
       nd.contextnumber:=Cfg.GetValue('Files/FileName'+IntToStr(I)+'/ContextNumber',0);
       nd.contextname:=Cfg.GetValue('Files/FileName'+IntToStr(I)+'/ContextName','');
-      Files.AddObject(nd.urlname,nd);
+      Files.AddObject(nd.URLNAME,nd);
     end;
 
   FileCount := Cfg.GetValue('OtherFiles/Count/Value', 0);
@@ -526,7 +535,7 @@ var
 begin
  { Defaults other than global }
    MakeBinaryIndex:=True;
-
+  FBasePath:=extractfilepath(expandfilename(afilename));
   Fini:=TMeminiFile.Create(AFileName);
   secs := TStringList.create;
   strs := TStringList.create;
@@ -679,25 +688,75 @@ begin
     OnError(self,errorkind,msg,detaillevel);
 end;
 
-procedure TChmProject.ScanHtml;
+const
+   protocols   : array[0..2] of string = ('HTTP:','FTP:','MS-ITS:');
+   protocollen : array[0..2] of integer= ( 5 ,4 ,7);
+
+function sanitizeurl(const basepath,instring:string;var outstring:String):Boolean;
+var i,j,len : integer;
+begin
+  result:=true; outstring:='';
+  if instring='' then
+    exit(false);
+
+  len:=length(instring);
+  if len=0 then
+    exit(false);
+  i:=0;
+  while (i<=high(protocols)) do
+    begin
+      if strlicomp(@protocols[i][1],@instring[1],protocollen[i])=0 then
+        exit(false);
+      inc(i);
+    end;
+   outstring:=instring;
+
+   i:=pos('#',outstring);
+   if i<>0 then
+     delete(outstring,i,length(outstring)-i+1);
+
+  outstring:=expandfilename(StringReplace(outstring,'%20',' ',[rfReplaceAll]));// expandfilename(instring));
+
+  outstring:=extractrelativepath(basepath,outstring);
+  outstring:=StringReplace(outstring,'\','/',[rfReplaceAll]);
+end;
+
+function  TChmProject.FileInTotalList(const s:String):boolean;
+
+begin
+  FSpareString.TheString:=S;
+  result:=assigned(fTotalFileList.FindKey(FSpareString,@CompareStrings));
+end;
+
+procedure TChmProject.ScanList(toscan,newfiles:TStrings;recursion:boolean);
+ // toscan, list to search for htmlfiles to scan.
+ // newfiles, the resulting list of files.
+ // totalfilelist, the list that contains all found and specified files to check against.
+ // localfilelist (local var), files found in this file.
+var
+  localpath : string;
 
 procedure checkattributes(node:TDomNode;attributename:string;filelist :TStringList);
 var
     Attributes: TDOMNamedNodeMap;
     atnode    : TDomNode;
     fn        : String;
+    n         : integer;
 begin
   if assigned(node) then
     begin
       Attributes:=node.Attributes;
       if assigned(attributes) then
          begin
-           atnode :=attributes.GetNamedItem(attributename);
-           if assigned(atnode) then
+           for n:=0 to attributes.length-1 do
              begin
-               fn:=atnode.nodevalue;
-               if (fn<>'') then
-                  filelist.add(fn);
+               atnode :=attributes[n];
+               if assigned(atnode) and (uppercase(atnode.nodename)=attributename) then
+                 begin
+                   if sanitizeurl(fbasepath,localpath+atnode.nodevalue,fn) then
+                    if not FileInTotalList(uppercase(fn)) then
+                      filelist.add(fn);
+                 end;
              end;
          end;
     end;
@@ -707,6 +766,7 @@ end;
 function scantags(prnt:TDomNode;filelist:TStringlist):TDomNode;
 // Seach first matching tag in siblings
 var chld: TDomNode;
+    s   : ansistring;
 begin
   result:=nil;
   if assigned(prnt )  then
@@ -717,18 +777,22 @@ begin
           scantags(chld,filelist);  // depth first.
           if (chld is TDomElement) then
             begin
-             // writeln(tdomelement(chld).tagname,' ',chld.classname	);
-              if tdomelement(chld).tagname='link'then
+              s:=uppercase(tdomelement(chld).tagname);
+              if s='LINK' then
                 begin
                   //printattributes(chld,'');
-                  checkattributes(chld,'href',filelist);
+                  checkattributes(chld,'HREF',filelist);
                 end;
-             if tdomelement(chld).tagname='img'then
+             if s='IMG'then
                begin
                   //printattributes(chld,'');
-                  checkattributes(chld,'src',filelist);
+                  checkattributes(chld,'SRC',filelist);
+               end;
+             if s='A'then
+               begin
+                  //printattributes(chld,'');
+                  checkattributes(chld,'HREF',filelist);
                 end;
-
             end;
           chld:=chld.nextsibling;
         end;
@@ -736,18 +800,44 @@ begin
 end;
 
 var
-  filelist, localfilelist: TStringList;
+  localfilelist: TStringList;
   domdoc : THTMLDocument;
-  i,j  : Integer;
-  fn,s  : string;
-  ext : String;
+  i,j    : Integer;
+  fn,s   : string;
+  ext    : String;
+  tmplst : Tstringlist;
+  strrec : TStringIndex;
+  //localpath : string;
+
+function trypath(const vn:string):boolean;
+var vn2: String;
+  strrec : TStringIndex;
 begin
- filelist:= TStringList.create;
- localfilelist:= TStringList.create;
+  vn2:=uppercase(vn);
+  if FileInTotalList(vn2) then
+   begin
+     Error(ChmNote,'Found duplicate file '+vn+' while scanning '+fn,1);
+     exit(false);
+   end;
 
- for j:=0 to Files.count-1 do
+  result:=false;
+  if fileexists(vn) then  // correct for relative path .html file?
+    begin
+      result:=true;
+      StrRec:=TStringIndex.Create;
+      StrRec.TheString:=vn2;
+      StrRec.Strid    :=0;
+      fTotalFileList.Add(StrRec);
+      newfiles.add(vn);
+      Error(ChmNote,'Found file '+vn+' while scanning '+fn,1);
+    end;
+end;
+
+begin
+ localfilelist:=TStringList.Create;
+ for j:=0 to toscan.count-1 do
    begin
-     fn:=files[j];
+     fn:=toscan[j];
      localfilelist.clear;
      if (FAllowedExtensions.Indexof(uppercase(extractfileext(fn)))<>-1) then
        begin
@@ -757,20 +847,16 @@ begin
              try
                Error(chmnote,'Scanning file '+fn+'.',5);
                ReadHtmlFile(domdoc,fn);
-
+               localpath:=extractfilepath(fn);
+               if (length(localpath)>0) and not (localpath[length(localpath)] in ['/','\']) then
+                 localpath:=localpath+pathsep;
                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
+                   if not trypath(s) then
+//                     if not trypath(localpath+s) then
                        Error(ChmWarning,'Found file '+s+' while scanning '+fn+', but couldn''t find it on disk',2);
-                     end
                  end;
              except
                on e:exception do
@@ -786,21 +872,148 @@ begin
      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;
+  if (newfiles.count>0) and recursion then
+    begin
+      tmplst:=TStringList.Create;
+      scanlist(newfiles,tmplst,true);
+      newfiles.addstrings(tmplst);
+      tmplst.free;
+    end;
+end;
+
+procedure TChmProject.ScanSitemap(sitemap:TChmSiteMap;newfiles:TStrings;recursion:boolean);
+
+procedure scanitems(it:TChmSiteMapItems);
+
+var i : integer;
+    x : TChmSiteMapItem;
+    s : string;
+    strrec : TStringIndex;
+
+begin
+  for i:=0 to it.count -1 do
+    begin
+      x:=it.item[i];
+      if sanitizeurl(fbasepath,x.local,S) then   // sanitize, remove stuff etc.
+        begin
+          if not FileInTotalList(uppercase(s)) then
+            begin
+              if fileexists(s) then
+                begin
+                  Error(chmnote,'Good url: '+s+'.',5);
+                  StrRec:=TStringIndex.Create;
+                  StrRec.TheString:=uppercase(s);
+                  StrRec.Strid    :=0;
+                  fTotalFileList.Add(StrRec);
+                  newfiles.add(s);
+                end
+              else
+                Error(chmnote,'duplicate url: '+s+'.',5);
+            end
+          else
+            Error(chmnote,'duplicate url: '+s+'.',5);
+        end
+      else
+       Error(chmnote,'Bad url: '+s+'.',5);
+
+      if assigned(x.children) and (x.children.count>0) then
+        scanitems(x.children);
+    end;
+end;
+
+var i : integer;
+    localfilelist: TStringList;
+
+begin
+  localfilelist:=TStringList.Create;
+  scanitems(sitemap.items);
+  scanlist(newfiles,localfilelist,true);
+  newfiles.addstrings(localfilelist);
+  localfilelist.free;
+end;
+
+procedure TChmProject.ScanHtml;
+var
+  helplist,
+  localfilelist: TStringList;
+  i      : integer;
+  x      : TChmSiteMap;
+  strrec : TStringIndex;
+begin
+
+ for i:=0 to otherfiles.count-1 do
+   begin
+     StrRec:=TStringIndex.Create;
+     StrRec.TheString:=uppercase(otherfiles[i]);
+     StrRec.Strid    :=0;
+     fTotalFileList.Add(StrRec);
+   end;
+
+ for i:=0 to files.count-1 do
+   begin
+     StrRec:=TStringIndex.Create;
+     StrRec.TheString:=uppercase(files[i]);
+     StrRec.Strid    :=0;
+     fTotalFileList.Add(StrRec);
+   end;
+
+ localfilelist:= TStringList.create;
+ scanlist(ffiles,localfilelist,true);
+ otherfiles.addstrings(localfilelist);
+ localfilelist.clear;
+ if (FDefaultpage<>'') and (not FileInTotalList(uppercase(fdefaultpage))) then
+   begin
+     Error(chmnote,'Scanning default file : '+fdefaultpage+'.',3);
+     helplist:=TStringlist.Create;
+     helplist.add(fdefaultpage);
+     scanlist(helplist,localfilelist,true);
+     otherfiles.addstrings(localfilelist);
+     localfilelist.clear;
+   end;
+ if FTableOfContentsFileName<>'' then
+   begin
+     if fileexists(FTableOfContentsFileName) then
+       begin
+       Error(chmnote,'Scanning TOC file : '+FTableOfContentsFileName+'.',3);
+        x:=TChmSiteMap.Create(sttoc);
+        try
+          x.loadfromfile(FTableOfcontentsFilename);
+          scansitemap(x,localfilelist,true);
+          otherfiles.addstrings(localfilelist);
+        except
+          on e: Exception do
+            error(chmerror,'Error loading TOC file '+FTableOfContentsFileName);
+          end;
+        x.free;
+       end
+     else
+       error(chmerror,'Can''t find TOC file'+FTableOfContentsFileName);
+   end;
+  LocalFileList.clear;
+  if FIndexFileName<>'' then
+   begin
+     if fileexists(FIndexFileName) then
+       begin
+       Error(chmnote,'Scanning Index file : '+FIndexFileName+'.',3);
+        x:=TChmSiteMap.Create(stindex);
+        try
+          x.loadfromfile(FIndexFileName);
+          scansitemap(x,localfilelist,true);
+          otherfiles.addstrings(localfilelist);
+        except
+          on e: Exception do
+            error(chmerror,'Error loading index file '+FIndexFileName);
+          end;
+        x.free;
+       end
+     else
+       error(chmerror,'Can''t find TOC index file '+FIndexFileName);
+   end;
  localfilelist.free;
 end;
 
+
 procedure TChmProject.WriteChm(AOutStream: TStream);
 var
   Writer     : TChmWriter;

packages/chm/src/chmls.lpr

@@ -38,6 +38,7 @@ type
     Section  : Integer;
     count    : integer;
     donotpage: boolean;
+    nameonly : boolean;
     procedure OnFileEntry(Name: String; Offset, UncompressedSize, ASection: Integer);
   end;
 
@@ -49,13 +50,13 @@ type
   end;
 
 
-  TCmdEnum = (cmdList,cmdExtract,cmdExtractall,cmdUnblock,cmdNone);        // One dummy element at the end avoids rangecheck errors.
+  TCmdEnum = (cmdList,cmdExtract,cmdExtractall,cmdUnblock,cmdextractalias,cmdNone);        // One dummy element at the end avoids rangecheck errors.
 
 Const
-  CmdNames : array [TCmdEnum] of String = ('LIST','EXTRACT','EXTRACTALL','UNBLOCK','');
+  CmdNames : array [TCmdEnum] of String = ('LIST','EXTRACT','EXTRACTALL','UNBLOCK','EXTRACTALIAS','');
 
 var
-  theopts : array[1..2] of TOption;
+  theopts : array[1..4] of TOption;
 
 
 Procedure Usage;
@@ -64,8 +65,9 @@ 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,' -h, --help     : this screen');
+  writeln(stderr,' -p, --no-page  : do not page list output');
+  writeln(stderr,' -n,--name-only : only show "name" column in 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] ');
@@ -79,6 +81,11 @@ begin
   writeln(stderr,' unblockchm <filespec1> [filespec2] ..' );
   writeln(stderr,'            Mass unblocks (XPsp2+) the relevant CHMs. Multiple files');
   writeln(stderr,'            and wildcards allowed');
+  writeln(stderr,' extractalias <chmfilename> [basefilename] [symbolprefix]' );
+  writeln(stderr,'            Extracts context info from file "chmfilename" ');
+  writeln(stderr,'            to a "basefilename".h and "basefilename".ali,');
+  writeln(stderr,'            using symbols "symbolprefix"contextnr');
+
   Halt(1);
 end;
 
@@ -100,6 +107,18 @@ begin
     value:=#0;
   end;
   with theopts[2] do
+   begin
+    name:='name-only';
+    has_arg:=0;
+    flag:=nil;
+  end;
+  with theopts[3] do
+   begin
+    name:='no-page';
+    has_arg:=0;
+    flag:=nil;
+  end;
+  with theopts[4] do
    begin
     name:='';
     has_arg:=0;
@@ -154,13 +173,16 @@ begin
   if (Section > -1) and (ASection <> Section) then Exit;
   if (Count = 1) or ((Count mod 40 = 0) and not donotpage) then
     WriteLn(StdErr, '<Section> <Offset> <UnCompSize>  <Name>');
-  Write(' ');
-  Write(ASection);
-  Write('      ');
-  WriteStrAdj(IntToStr(Offset), 10);
-  Write('  ');
-  WriteStrAdj(IntToStr(UncompressedSize), 11);
-  Write('  ');
+  if not nameonly then
+    begin
+      Write(' ');
+      Write(ASection);
+      Write('      ');
+      WriteStrAdj(IntToStr(Offset), 10);
+      Write('  ');
+      WriteStrAdj(IntToStr(UncompressedSize), 11);
+      Write('  ');
+    end;
   WriteLn(Name);
 end;
 
@@ -216,6 +238,7 @@ begin
 end;
 
 var donotpage:boolean=false;
+    name_only :boolean=false;
 
 procedure ListChm(Const Name:string;Section:Integer);
 var
@@ -235,6 +258,7 @@ begin
   JunkObject.Section:=Section;
   JunkObject.Count:=0;
   JunkObject.DoNotPage:=DoNotPage;
+  JunkObject.NameOnly:=Name_Only;
 
   ITS:= TITSFReader.Create(Stream, True);
   ITS.GetCompleteFileList(@JunkObject.OnFileEntry);
@@ -322,6 +346,65 @@ begin
   r.free;
 end;
 
+procedure ExtractAlias(filespec:TStringDynArray);
+
+var s,
+    chm,
+    prefixfn,
+    symbolname : string;
+    i,cnt: integer;
+    cl : TList;
+    x : PcontextItem;
+    f : textfile;
+    fs: TFileStream;
+    r : TChmReader;
+
+begin
+  symbolname:='helpid';
+  chm:=filespec[0];
+  prefixfn:=changefileext(chm,'');
+  if length(filespec)>1 then
+    prefixfn:=filespec[1];
+  if length(filespec)>2 then
+    symbolname:=filespec[2];
+
+
+  if not Fileexists(chm) then
+    begin
+      writeln(stderr,' Can''t find file ',chm);
+      halt(1);
+    end;
+  fs:=TFileStream.create(chm,fmOpenRead);
+  r:=TCHMReader.create(fs,true);
+  cl:=r.contextlist;
+  if assigned(cl) and (cl.count>0) then
+    begin
+      cnt:=cl.count;
+      assignfile(f,changefileext(chm,'.ali'));
+      rewrite(f);
+      for i:=0 to cnt-1 do
+        begin
+          x:=pcontextitem(cl[i]);
+          s:=x^.url;
+          if (length(s)>0) and (s[1]='/') then
+            delete(s,1,1);
+
+          writeln(f,symbolname,x^.context,'=',s);
+        end;
+      closefile(f);
+      assignfile(f,changefileext(chm,'.h'));
+      rewrite(f);
+      for i:=0 to cnt-1 do
+        begin
+          x:=pcontextitem(cl[i]);
+          writeln(f,'#define ',symbolname,x^.context,' ',x^.context);
+        end;
+      closefile(f);
+    end;
+   r.free;
+end;
+
+
 procedure unblockchm(s:string);
 var f : file;
 begin
@@ -408,7 +491,7 @@ begin
   Writeln(stderr,'chmls, a CHM utility. (c) 2010 Free Pascal core.');
   Writeln(Stderr);
   repeat
-    c:=getlongopts('hn',@theopts[1],optionindex);
+    c:=getlongopts('hnp',@theopts[1],optionindex);
     case c of
       #0 : begin
              case optionindex-1 of
@@ -416,9 +499,13 @@ begin
                      Usage;
                      Halt;
                    end;
+               1 : name_only:=true;
+               2 : donotpage:=true;
+
                 end;
            end;
-      'n'     : donotpage:=true;
+      'p'     : donotpage:=true;
+      'n'     : name_only:=true;
       '?','h' :
             begin
               writeln('unknown option',optopt);
@@ -471,7 +558,12 @@ begin
                       else
                         WrongNrParam(cmdnames[cmd],length(localparams));
                      end;
-
+      cmdextractalias: begin
+                        if length(localparams)>0 then
+                          extractalias(localparams)
+                        else
+                          WrongNrParam(cmdnames[cmd],length(localparams));
+                       end;
       end; {case cmd of}
   end
  else

packages/chm/src/chmwriter.pas

@@ -38,7 +38,7 @@ Type
   //  Stream   :  the file opened with DataName should be written to this stream
 
 Type
-   TStringIndex = Class    // AVLTree needs wrapping in non automated reference type
+   TStringIndex = Class    // AVLTree needs wrapping in non automated reference type also used in filewriter.
                       TheString : String;
                       StrId     : Integer;
                     end;
@@ -205,6 +205,8 @@ Type
     property DefaultWindow : string read fdefaultwindow write fdefaultwindow;
   end;
 
+Function CompareStrings(Node1, Node2: Pointer): integer; // also used in filewriter
+
 implementation
 uses dateutils, sysutils, paslzxcomp, chmFiftiMain;
 

packages/chm/src/itolitlsreader.pas

@@ -365,9 +365,9 @@ begin
     Exit(fCachedEntry.DecompressedLength); // we've already looked it up
 
   fCachedEntry.Name:='';
-  fCachedEntry.ContentSection:=-1;
+  fCachedEntry.ContentSection:=LongWord(-1);
   fCachedEntry.DecompressedLength:=0;
-  fCachedEntry.ContentOffset:=-1;
+  fCachedEntry.ContentOffset:=QWord(-1);
 
   StreamPos:=HeaderSectionTable[1].OffSet;
   fStream.Read(IFCM, SizeOf(IFCM));

packages/fcl-passrc/src/pastree.pp

@@ -67,8 +67,8 @@ resourcestring
   SPasTreeDestructorImpl = 'destructor implementation';
 
 type
-  TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekRange,
-     pekUnary, pekBinary, pekFuncParams, pekArrayParams);
+  TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekNil, pekBoolConst, pekRange,
+     pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp);
 
   TExprOpCode = (eopNone,
                  eopAdd,eopSubtract,eopMultiply,eopDivide, eopDiv,eopMod, eopPower,// arithmetic
@@ -77,7 +77,8 @@ type
                  eopEqual, eopNotEqual,  // Logical
                  eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual, // ordering
                  eopIn,eopIs,eopAs, eopSymmetricaldifference, // Specials
-                 eopAddress);
+                 eopAddress, eopDeref, // Pointers
+                 eopSubIdent); // SomeRec.A, A is subIdent of SomeRec
   
   { TPasExpr }
 
@@ -107,6 +108,18 @@ type
     Value     : AnsiString;
     constructor Create(AKind: TPasExprKind; const AValue : Ansistring);
   end;
+  
+  TBoolConstExpr = class(TPasExpr)
+    Value     : Boolean;
+    constructor Create(AKind: TPasExprKind; const ABoolValue : Boolean);
+  end;
+
+  { TNilExpr }
+
+  TNilExpr = class(TPasExpr)
+    Value     : Boolean;
+    constructor Create;
+  end;
 
   { TParamsExpr }
 
@@ -119,6 +132,30 @@ type
     procedure AddParam(xp: TPasExpr);
   end;
 
+  { TRecordValues }
+
+  TRecordValuesItem = record
+    Name      : AnsiString;
+    ValueExp  : TPasExpr;
+  end;
+
+  TRecordValues = class(TPasExpr)
+    Fields    : array of TRecordValuesItem;
+    constructor Create;
+    destructor Destroy; override;
+    procedure AddField(const Name: AnsiString; Value: TPasExpr);
+  end;
+
+  { TArrayValues }
+
+  TArrayValues = class(TPasExpr)
+    Values    : array of TPasExpr;
+    constructor Create;
+    destructor Destroy; override;
+    procedure AddValues(AValue: TPasExpr);
+  end;
+
+
   // Visitor pattern.
   TPassTreeVisitor = class;
 
@@ -2352,6 +2389,15 @@ begin
   Value:=AValue;
 end;
 
+{ TBoolConstExpr }
+
+constructor TBoolConstExpr.Create(AKind: TPasExprKind; const ABoolValue : Boolean);
+begin
+  inherited Create(AKind, eopNone);
+  Value:=ABoolValue;
+end;
+
+
 { TUnaryExpr }
 
 constructor TUnaryExpr.Create(AOperand: TPasExpr; AOpCode: TExprOpCode);
@@ -2412,4 +2458,60 @@ begin
   inherited Destroy;
 end;
 
+{ TRecordValues }
+
+constructor TRecordValues.Create;
+begin
+  inherited Create(pekListOfExp, eopNone);
+end;
+
+destructor TRecordValues.Destroy;
+var
+  i : Integer;
+begin
+  for i:=0 to length(Fields)-1 do Fields[i].ValueExp.Free;
+  inherited Destroy;
+end;
+
+procedure TRecordValues.AddField(const Name:AnsiString;Value:TPasExpr);
+var
+  i : Integer;
+begin
+  i:=length(Fields);
+  SetLength(Fields, i+1);
+  Fields[i].Name:=Name;
+  Fields[i].ValueExp:=Value;
+end;
+
+{ TArrayValues }
+
+constructor TArrayValues.Create;
+begin
+  inherited Create(pekListOfExp, eopNone)
+end;
+
+destructor TArrayValues.Destroy;
+var
+  i : Integer;
+begin
+  for i:=0 to length(Values)-1 do Values[i].Free;
+  inherited Destroy;
+end;
+
+procedure TArrayValues.AddValues(AValue:TPasExpr);
+var
+  i : Integer;
+begin
+  i:=length(Values);
+  SetLength(Values, i+1);
+  Values[i]:=AValue;
+end;
+
+{ TNilExpr }
+
+constructor TNilExpr.Create;
+begin
+  inherited Create(pekNil, eopNone);
+end;
+
 end.

packages/fcl-passrc/src/pparser.pp

@@ -143,7 +143,8 @@ type
     function ParseComplexType(Parent : TPasElement = Nil): TPasType;
     procedure ParseArrayType(Element: TPasArrayType);
     procedure ParseFileType(Element: TPasFileType);
-    function DoParseExpression: TPasExpr;
+    function DoParseExpression(InitExpr: TPasExpr=nil): TPasExpr;
+    function DoParseConstValueExpression: TPasExpr;
     function ParseExpression: String;
     function ParseCommand: String; // single, not compound command like begin..end
     procedure AddProcOrFunction(Declarations: TPasDeclarations; AProc: TPasProcedure);
@@ -642,7 +643,7 @@ end;
 
 const
   EndExprToken = [
-    tkEOF, tkBraceClose, tkSquaredBraceClose, tkSemicolon,
+    tkEOF, tkBraceClose, tkSquaredBraceClose, tkSemicolon, tkComma, tkColon,
     tkdo, tkdownto, tkelse, tkend, tkof, tkthen, tkto
   ];
 
@@ -654,7 +655,6 @@ var
   PClose  : TToken;
 begin
   Result:=nil;
-
   if paramskind in [pekArrayParams, pekSet] then begin
     if CurToken<>tkSquaredBraceOpen then Exit;
     PClose:=tkSquaredBraceClose;
@@ -720,8 +720,10 @@ begin
     tkDiv                   : Result:=eopDiv;
     tkNot                   : Result:=eopNot;
     tkIn                    : Result:=eopIn;
+    tkDot                   : Result:=eopSubIdent;
+    tkCaret                 : Result:=eopDeref;
   else
-    Raise Exception.CreateFmt('Not an operand: (%d : %s)',[AToken,TokenInfos[AToken]]);
+    ParseExc(format('Not an operand: (%d : %s)',[AToken,TokenInfos[AToken]]));
   end;
 end;
  
@@ -731,12 +733,16 @@ var
   prm     : TParamsExpr;
   u       : TUnaryExpr;
   b       : TBinaryExpr;
+  optk    : TToken;
 begin
   Result:=nil;
   case CurToken of
     tkString:           x:=TPrimitiveExpr.Create(pekString, CurTokenString);
+    tkChar:             x:=TPrimitiveExpr.Create(pekString, CurTokenText);
     tkNumber:           x:=TPrimitiveExpr.Create(pekNumber, CurTokenString);
     tkIdentifier:       x:=TPrimitiveExpr.Create(pekIdent, CurTokenText);
+    tkfalse, tktrue:    x:=TBoolConstExpr.Create(pekBoolConst, CurToken=tktrue);
+    tknil:              x:=TNilExpr.Create;
     tkSquaredBraceOpen: x:=ParseParams(pekSet);
   else
     ParseExc(SParserExpectedIdentifier);
@@ -768,8 +774,9 @@ begin
         end;
 
       if CurToken in [tkDot, tkas] then begin
+        optk:=CurToken;
         NextToken;
-        b:=TBinaryExpr.Create(x, ParseExpIdent, TokenToExprOp(CurToken));
+        b:=TBinaryExpr.Create(x, ParseExpIdent(), TokenToExprOp(optk));
         if not Assigned(b.right) then Exit; // error
         x:=b;
       end;
@@ -804,7 +811,7 @@ begin
   end;
 end;
 
-function TPasParser.DoParseExpression: TPasExpr;
+function TPasParser.DoParseExpression(InitExpr: TPasExpr): TPasExpr;
 var
   expstack  : TList;
   opstack   : TList;
@@ -863,28 +870,50 @@ begin
     repeat
       AllowEnd:=True;
       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 begin
-        x:=ParseExpIdent;
-      end;
+      if not Assigned(InitExpr) then
+      begin
+        // the first part of the expression has been parsed externally.
+        // this is used by Constant Expresion parser (CEP) parsing only,
+        // whenever it makes a false assuming on constant expression type.
+        // i.e: SI_PAD_SIZE = ((128/sizeof(longint)) - 3);
+        //
+        // CEP assumes that it's array or record, because the expression
+        // starts with "(". After the first part is parsed, the CEP meets "-"
+        // that assures, it's not an array expression. The CEP should give the
+        // first partback to the expression parser, to get the correct
+        // token tree according to the operations priority.
+        //
+        // quite ugly. type information is required for CEP to work clean
+
+        while CurToken in PrefixSym do begin
+          PushOper(CurToken);
+          inc(pcount);
+          NextToken;
+        end;
 
-      if not Assigned(x) then Exit;
-      expstack.Add(x);
-      for i:=1 to pcount do
-        begin
-        tempop:=PopOper;
-        expstack.Add( TUnaryExpr.Create( PopExp, TokenToExprOp(tempop) ));
+        if CurToken = tkBraceOpen then begin
+          NextToken;
+          x:=DoParseExpression();
+          if CurToken<>tkBraceClose then Exit;
+          NextToken;
+        end else begin
+          x:=ParseExpIdent;
         end;
+
+        if not Assigned(x) then Exit;
+        expstack.Add(x);
+        for i:=1 to pcount do begin
+          tempop:=PopOper;
+          expstack.Add( TUnaryExpr.Create( PopExp, TokenToExprOp(tempop) ));
+        end;
+
+      end else
+      begin
+        expstack.Add(InitExpr);
+        InitExpr:=nil;
+      end;
+
       if not (CurToken in EndExprToken) then begin
         // Adjusting order of the operations
         AllowEnd:=False;
@@ -963,6 +992,66 @@ begin
   UngetToken;
 end;
 
+function GetExprIdent(p: TPasExpr): String;
+begin
+  if Assigned(p) and (p is TPrimitiveExpr) and (p.Kind=pekIdent) then
+    Result:=TPrimitiveExpr(p).Value
+  else
+    Result:='';
+end;
+
+function TPasParser.DoParseConstValueExpression: TPasExpr;
+var
+  x : TPasExpr;
+  n : AnsiString;
+  r : TRecordValues;
+  a : TArrayValues;
+begin
+  if CurToken <> tkBraceOpen then
+    Result:=DoParseExpression
+  else begin
+    NextToken;
+    x:=DoParseConstValueExpression();
+    case CurToken of
+      tkComma: // array of values (a,b,c);
+        begin
+          a:=TArrayValues.Create;
+          a.AddValues(x);
+          repeat
+            NextToken;
+            x:=DoParseConstValueExpression();
+            a.AddValues(x);
+          until CurToken<>tkComma;
+          Result:=a;
+        end;
+
+      tkColon: // record field (a:xxx;b:yyy;c:zzz);
+        begin
+          n:=GetExprIdent(x);
+          x.Free;
+          r:=TRecordValues.Create;
+          NextToken;
+          x:=DoParseConstValueExpression();
+          r.AddField(n, x);
+          if CurToken=tkSemicolon then
+            repeat
+              n:=ExpectIdentifier;
+              ExpectToken(tkColon);
+              NextToken;
+              x:=DoParseConstValueExpression();
+              r.AddField(n, x)
+            until CurToken<>tkSemicolon;
+          Result:=r;
+        end;
+    else
+      // Binary expression!  ((128 div sizeof(longint)) - 3);       ;
+      Result:=DoParseExpression(x);
+    end;
+    if CurToken<>tkBraceClose then ParseExc(SParserExpectedCommaRBracket);
+    NextToken;
+  end;
+end;
+
 function TPasParser.ParseCommand: String;
 var
   BracketLevel: Integer;
@@ -1443,7 +1532,7 @@ begin
 
     // using new expression parser!
     NextToken; // skip tkEqual
-    Result.Expr:=DoParseExpression;
+    Result.Expr:=DoParseConstValueExpression;
 
     // must unget for the check to be peformed fine!
     UngetToken;
@@ -3066,8 +3155,7 @@ begin
       if (s = 'sealed') or (s = 'abstract') then begin
         TPasClassType(Result).Modifiers.Add(s);
         NextToken;
-      end else
-        ExpectToken(tkSemicolon);
+      end;
     end;
 
     // Parse ancestor list

packages/fcl-passrc/src/pscanner.pp

@@ -632,7 +632,7 @@ begin
           Inc(TokenStr);
           repeat
             Inc(TokenStr);
-          until not (TokenStr[0] in ['0'..'9', 'A'..'F', 'a'..'F']);
+          until not (TokenStr[0] in ['0'..'9', 'A'..'F', 'a'..'f']);
         end else
           repeat
             Inc(TokenStr);
@@ -661,7 +661,7 @@ begin
         TokenStart := TokenStr;
         repeat
           Inc(TokenStr);
-        until not (TokenStr[0] in ['0'..'9', 'A'..'F', 'a'..'F']);
+        until not (TokenStr[0] in ['0'..'9', 'A'..'F', 'a'..'f']);
         SectionLength := TokenStr - TokenStart;
         SetLength(FCurTokenString, SectionLength);
         if SectionLength > 0 then

utils/fpdoc/dwlinear.pp

@@ -869,7 +869,9 @@ begin
       WriteSeeAlso(DocNode);
       EndProcedure;
       WriteExample(DocNode);
-      end;
+      end
+     else
+      EndProcedure;
     end;
 end;
 
@@ -970,7 +972,9 @@ begin
       WriteSeeAlso(DocNode);
       EndProperty;
       WriteExample(DocNode);
-      end;
+      end
+     else
+      EndProperty;
     end;
 end;