* 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))

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@15563 3ad0048d-3df7-0310-abae-a5850022a9f2

3 files changed, 224 insertions, 51 deletions

diff --git a/packages/chm/src/chmcmd.lpr b/packages/chm/src/chmcmd.lpr
index 8cbf331b24..caf7c53f66 100644
--- a/packages/chm/src/chmcmd.lpr
+++ b/packages/chm/src/chmcmd.lpr
@@ -154,10 +154,6 @@ begin
   repeat
     c:=getlongopts('h',@theopts[1],optionindex);
     case c of
-      '1','2','3','4','5','6','7','8','9' :
-        begin
-        writeln ('Got optind : ',c)
-        end;
       #0 : begin
              case optionindex-1 of
                0 : htmlscan:=scanforce;
diff --git a/packages/chm/src/chmls.lpr b/packages/chm/src/chmls.lpr
index 1035d6610f..b46813daa3 100644
--- a/packages/chm/src/chmls.lpr
+++ b/packages/chm/src/chmls.lpr
@@ -27,25 +27,65 @@ 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;
     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);
+  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 WriteStr(Str: String; CharWidth: Integer);
+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 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 +93,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 +101,186 @@ 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) 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;
-
-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;
+
   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('h',@theopts[1],optionindex);
+    case c of
+      #0 : begin
+             case optionindex-1 of
+               0 : begin;
+                     Usage;
+                     Halt;
+                   end;
+                end;
+           end;
+      '?','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.
 
diff --git a/packages/chm/src/chmreader.pas b/packages/chm/src/chmreader.pas
index f901cac1c6..db0a3f5e4b 100644
--- a/packages/chm/src/chmreader.pas
+++ b/packages/chm/src/chmreader.pas
@@ -105,7 +105,7 @@ type
     fURLTBLStream,
     fStringsStream: TMemoryStream;
     fLocaleID: DWord;
-    fWindows      : TObjectList;
+    fWindowsList : TObjectList;
     fDefaultWindow: String;
   private
     FSearchReader: TChmSearchReader;
@@ -132,7 +132,7 @@ type
     property LocaleID: dword read fLocaleID;
     property SearchReader: TChmSearchReader read FSearchReader write FSearchReader;
     property contextlist : tcontextlist read fcontextlist;
-    property Windows : TObjectlist read fwindows;
+    property Windows : TObjectlist read fWindowsList;
     property DefaultWindow : string read fdefaultwindow;
   end;
 
@@ -215,10 +215,10 @@ begin
   fITSFHeader.TimeStamp := BEtoN(fITSFHeader.TimeStamp);//bigendian
   fITSFHeader.LanguageID := LEtoN(fITSFHeader.LanguageID);
   {$ENDIF}
- 
+
   if fITSFHeader.Version < 4 then
    fStream.Seek(SizeOf(TGuid)*2, soCurrent);
-  
+
   if not IsValidFile then Exit;
 
   ReadHeaderEntries;
@@ -518,7 +518,8 @@ var
   version   : integer;
   x         : TChmWindow;
 begin
- fWindows.Clear;
+ if not assigned(fwindowslist) then
+ fWindowsList.Clear;
  mem.Position:=0;
  cnt  := LEtoN(mem.ReadDWord);
  version  := LEtoN(mem.ReadDWord);
@@ -574,26 +575,27 @@ begin
          dec(version,4);
        end;
 
-     fWindows.Add(x);
+     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;
-  fWindows      := TObjectlist.Create(True);
-  fDefaultWindow:='';
 end;
 
 destructor TChmReader.Destroy;
 begin
   FreeAndNil(fContextList);
-  FreeAndNil(FWindows);
+  FreeAndNil(FWindowslist);
   FreeAndNil(FSearchReader);
   FreeAndNil(fTOPICSStream);
   FreeAndNil(fURLSTRStream);