* first commit of new fpcmake

utils/fpcm/fpcmake.pp

@@ -0,0 +1,63 @@
+{
+    $Id$
+    Copyright (c) 2001 by Peter Vreman
+
+    Convert Makefile.fpc to Makefile
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$ifdef fpc}{$mode objfpc}{$endif}
+{$H+}
+program fpcmake;
+
+    uses
+      dos,sysutils,
+      fpcmmain,fpcmwr;
+
+    procedure ProcessFile(const fn:string);
+      var
+        CurrFPCMake : TFPCMake;
+        CurrMakefile : TMakefileWriter;
+        s : string;
+      begin
+        CurrFPCMake:=nil;
+//        try
+          CurrFPCMake:=TFPCMake.Create(fn);
+          s:=GetEnv('FPCDIR');
+          if s<>'' then
+           CurrFPCMake.Variables.Add('FPCDIR',s)
+          else
+           CurrFPCMake.Variables.Add('FPCDIR','c:/pp');
+          CurrFPCMake.Variables.Add('UNITSDIR','$(FPCDIR)/units');
+          CurrFPCMake.Variables.Add('PACKAGESDIR','$(FPCDIR)/packages');
+          CurrFPCMake.LoadMakefileFPC;
+          CurrFPCMake.LoadPackageSection;
+          CurrFPCMake.LoadRequires(CurrFPCMake);
+//          CurrFPCMake.Print;
+
+          CurrMakefile:=TMakefileWriter.Create(CurrFPCMake,'Makefile');
+          CurrMakefile.WriteGenericMakefile;
+          CurrMakefile.Free;
+
+//        except
+//          on e : exception do
+//           writeln('Error: ',e.message);
+//        end;
+        CurrFPCMake.Free;
+      end;
+
+begin
+  ProcessFile('Makefile.fpc');
+end.
+{
+  $Log$
+  Revision 1.1  2001-01-24 21:59:36  peter
+    * first commit of new fpcmake
+
+}

utils/fpcm/fpcmdic.pp

@@ -0,0 +1,544 @@
+{
+    $Id$
+    Copyright (c) 2001 by Peter Vreman
+
+    TDictionary class
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$ifdef fpc}{$mode objfpc}{$endif}
+{$H+}
+unit fpcmdic;
+interface
+
+    const       { the real size will be [-hasharray..hasharray] ! }
+       hasharraysize = 2047;
+
+    type
+       { namedindexobect for use with dictionary and indexarray }
+       TDictionaryItem=class
+       private
+         Fname      : string;
+         FSpeedValue : cardinal;
+       protected
+         procedure SetName(const n:string);
+       public
+         left,
+         right : TDictionaryItem;
+         constructor create(const n:string);
+         property Name:string read FName write SetName;
+         property SpeedValue:cardinal read FSpeedValue;
+       end;
+
+       Pdictionaryhasharray=^Tdictionaryhasharray;
+       Tdictionaryhasharray=array[-hasharraysize..hasharraysize] of TDictionaryItem;
+
+       Tnamedindexcallback = procedure(p:TDictionaryItem) of object;
+
+       Tdictionary=class
+       private
+         FRoot      : TDictionaryItem;
+         FHashArray : Pdictionaryhasharray;
+         procedure cleartree(obj:TDictionaryItem);
+         function  insertNode(NewNode:TDictionaryItem;var currNode:TDictionaryItem):TDictionaryItem;
+         procedure inserttree(currtree,currroot:TDictionaryItem);
+       public
+         noclear   : boolean;
+         replace_existing : boolean;
+         constructor Create;
+         destructor  Destroy;override;
+         procedure usehash;
+         procedure clear;
+         function  delete(const s:string):TDictionaryItem;
+         function  empty:boolean;
+         procedure foreach(proc2call:Tnamedindexcallback);
+         function  insert(obj:TDictionaryItem):TDictionaryItem;
+         function  rename(const olds,News : string):TDictionaryItem;
+         function  search(const s:string):TDictionaryItem;
+         function  speedsearch(const s:string;SpeedValue:integer):TDictionaryItem;
+         property  Items[const s:string]:TDictionaryItem read Search;default;
+       end;
+
+    { Speed/Hash value }
+    Function GetSpeedValue(Const s:String):cardinal;
+
+
+implementation
+
+
+{*****************************************************************************
+                               GetSpeedValue
+*****************************************************************************}
+
+var
+  Crc32Tbl : array[0..255] of cardinal;
+
+procedure MakeCRC32Tbl;
+var
+  crc : cardinal;
+  i,n : integer;
+begin
+  for i:=0 to 255 do
+   begin
+     crc:=i;
+     for n:=1 to 8 do
+      if odd(crc) then
+       crc:=(crc shr 1) xor $edb88320
+      else
+       crc:=crc shr 1;
+     Crc32Tbl[i]:=crc;
+   end;
+end;
+
+
+Function GetSpeedValue(Const s:String):cardinal;
+var
+  i : integer;
+  InitCrc : cardinal;
+begin
+  if Crc32Tbl[1]=0 then
+   MakeCrc32Tbl;
+  InitCrc:=$ffffffff;
+  for i:=1 to Length(s) do
+   InitCrc:=Crc32Tbl[byte(InitCrc) xor ord(s[i])] xor (InitCrc shr 8);
+  GetSpeedValue:=InitCrc;
+end;
+
+
+{****************************************************************************
+                               TDictionaryItem
+ ****************************************************************************}
+
+constructor TDictionaryItem.Create(const n:string);
+begin
+  left:=nil;
+  right:=nil;
+  FSpeedValue:=-1;
+  FName:=n;
+end;
+
+
+procedure TDictionaryItem.Setname(const n:string);
+begin
+  if FSpeedValue=-1 then
+   FName:=n;
+end;
+
+
+{****************************************************************************
+                               TDICTIONARY
+****************************************************************************}
+
+    constructor Tdictionary.Create;
+      begin
+        FRoot:=nil;
+        FHashArray:=nil;
+        noclear:=false;
+        replace_existing:=false;
+      end;
+
+
+    procedure Tdictionary.usehash;
+      begin
+        if not(assigned(FRoot)) and
+           not(assigned(FHashArray)) then
+         begin
+           New(FHashArray);
+           fillchar(FHashArray^,sizeof(FHashArray^),0);
+         end;
+      end;
+
+
+    destructor Tdictionary.destroy;
+      begin
+        if not noclear then
+         clear;
+        if assigned(FHashArray) then
+         dispose(FHashArray);
+      end;
+
+
+    procedure Tdictionary.cleartree(obj:TDictionaryItem);
+      begin
+        if assigned(obj.left) then
+          cleartree(obj.left);
+        if assigned(obj.right) then
+          cleartree(obj.right);
+        obj.free;
+        obj:=nil;
+      end;
+
+
+    procedure Tdictionary.clear;
+      var
+        w : integer;
+      begin
+        if assigned(FRoot) then
+          cleartree(FRoot);
+        if assigned(FHashArray) then
+         for w:=-hasharraysize to hasharraysize do
+          if assigned(FHashArray^[w]) then
+           cleartree(FHashArray^[w]);
+      end;
+
+
+    function Tdictionary.delete(const s:string):TDictionaryItem;
+    var
+      p,SpeedValue : cardinal;
+      n : TDictionaryItem;
+
+        procedure insert_right_bottom(var root,Atree:TDictionaryItem);
+        begin
+          while root.right<>nil do
+           root:=root.right;
+          root.right:=Atree;
+        end;
+
+        function delete_from_tree(root:TDictionaryItem):TDictionaryItem;
+        type
+          leftright=(left,right);
+        var
+          lr : leftright;
+          oldroot : TDictionaryItem;
+        begin
+          oldroot:=nil;
+          while (root<>nil) and (root.SpeedValue<>SpeedValue) do
+           begin
+             oldroot:=root;
+             if SpeedValue<root.SpeedValue then
+              begin
+                root:=root.right;
+                lr:=right;
+              end
+             else
+              begin
+                root:=root.left;
+                lr:=left;
+              end;
+           end;
+          while (root<>nil) and (root.name<>s) do
+           begin
+             oldroot:=root;
+             if s<root.name then
+              begin
+                root:=root.right;
+                lr:=right;
+              end
+             else
+              begin
+                root:=root.left;
+                lr:=left;
+              end;
+           end;
+          if root.left<>nil then
+           begin
+             { Now the Node pointing to root must point to the left
+               subtree of root. The right subtree of root must be
+               connected to the right bottom of the left subtree.}
+             if lr=left then
+              oldroot.left:=root.left
+             else
+              oldroot.right:=root.left;
+             if root.right<>nil then
+              insert_right_bottom(root.left,root.right);
+           end
+          else
+           begin
+             { There is no left subtree. So we can just replace the Node to
+               delete with the right subtree.}
+             if lr=left then
+              oldroot.left:=root.right
+             else
+              oldroot.right:=root.right;
+           end;
+          delete_from_tree:=root;
+        end;
+
+    begin
+      SpeedValue:=GetSpeedValue(s);
+      n:=FRoot;
+      if assigned(FHashArray) then
+       begin
+         { First, check if the Node to delete directly located under
+           the hasharray.}
+         p:=SpeedValue mod hasharraysize;
+         n:=FHashArray^[p];
+         if (n<>nil) and (n.SpeedValue=SpeedValue) and
+            (n.name=s) then
+          begin
+            { The Node to delete is directly located under the
+              hasharray. Make the hasharray point to the left
+              subtree of the Node and place the right subtree on
+              the right-bottom of the left subtree.}
+            if n.left<>nil then
+             begin
+               FHashArray^[p]:=n.left;
+               if n.right<>nil then
+                insert_right_bottom(n.left,n.right);
+             end
+            else
+             FHashArray^[p]:=n.right;
+            delete:=n;
+            exit;
+          end;
+       end
+      else
+       begin
+         { First check if the Node to delete is the root.}
+         if (FRoot<>nil) and (n.SpeedValue=SpeedValue) and
+            (n.name=s) then
+          begin
+            if n.left<>nil then
+             begin
+               FRoot:=n.left;
+               if n.right<>nil then
+                insert_right_bottom(n.left,n.right);
+             end
+            else
+             FRoot:=n.right;
+            delete:=n;
+            exit;
+          end;
+       end;
+      delete:=delete_from_tree(n);
+    end;
+
+    function Tdictionary.empty:boolean;
+      var
+        w : integer;
+      begin
+        if assigned(FHashArray) then
+         begin
+           empty:=false;
+           for w:=-hasharraysize to hasharraysize do
+            if assigned(FHashArray^[w]) then
+             exit;
+           empty:=true;
+         end
+        else
+         empty:=(FRoot=nil);
+      end;
+
+
+    procedure Tdictionary.foreach(proc2call:Tnamedindexcallback);
+
+        procedure a(p:TDictionaryItem);
+        begin
+          proc2call(p);
+          if assigned(p.left) then
+           a(p.left);
+          if assigned(p.right) then
+           a(p.right);
+        end;
+
+      var
+        i : integer;
+      begin
+        if assigned(FHashArray) then
+         begin
+           for i:=-hasharraysize to hasharraysize do
+            if assigned(FHashArray^[i]) then
+             a(FHashArray^[i]);
+         end
+        else
+         if assigned(FRoot) then
+          a(FRoot);
+      end;
+
+
+    function Tdictionary.insert(obj:TDictionaryItem):TDictionaryItem;
+      begin
+        obj.FSpeedValue:=GetSpeedValue(obj.name);
+        if assigned(FHashArray) then
+         insert:=insertNode(obj,FHashArray^[obj.SpeedValue mod hasharraysize])
+        else
+         insert:=insertNode(obj,FRoot);
+      end;
+
+
+    function tdictionary.insertNode(NewNode:TDictionaryItem;var currNode:TDictionaryItem):TDictionaryItem;
+      begin
+        if currNode=nil then
+         begin
+           currNode:=NewNode;
+           insertNode:=NewNode;
+         end
+        { First check SpeedValue, to allow a fast insert }
+        else
+         if currNode.SpeedValue>NewNode.SpeedValue then
+          insertNode:=insertNode(NewNode,currNode.right)
+        else
+         if currNode.SpeedValue<NewNode.SpeedValue then
+          insertNode:=insertNode(NewNode,currNode.left)
+        else
+         begin
+           if currNode.name>NewNode.name then
+            insertNode:=insertNode(NewNode,currNode.right)
+           else
+            if currNode.name<NewNode.name then
+             insertNode:=insertNode(NewNode,currNode.left)
+           else
+            begin
+              if replace_existing and
+                 assigned(currNode) then
+                begin
+                  NewNode.left:=currNode.left;
+                  NewNode.right:=currNode.right;
+                  currNode:=NewNode;
+                  insertNode:=NewNode;
+                end
+              else
+               insertNode:=currNode;
+             end;
+         end;
+      end;
+
+
+    procedure tdictionary.inserttree(currtree,currroot:TDictionaryItem);
+      begin
+        if assigned(currtree) then
+         begin
+           inserttree(currtree.left,currroot);
+           inserttree(currtree.right,currroot);
+           currtree.right:=nil;
+           currtree.left:=nil;
+           insertNode(currtree,currroot);
+         end;
+      end;
+
+
+    function tdictionary.rename(const olds,News : string):TDictionaryItem;
+      var
+        spdval : integer;
+        lasthp,
+        hp,hp2,hp3 : TDictionaryItem;
+      begin
+        spdval:=GetSpeedValue(olds);
+        if assigned(FHashArray) then
+         hp:=FHashArray^[spdval mod hasharraysize]
+        else
+         hp:=FRoot;
+        lasthp:=nil;
+        while assigned(hp) do
+          begin
+            if spdval>hp.SpeedValue then
+             begin
+               lasthp:=hp;
+               hp:=hp.left
+             end
+            else
+             if spdval<hp.SpeedValue then
+              begin
+                lasthp:=hp;
+                hp:=hp.right
+              end
+            else
+             begin
+               if (hp.name=olds) then
+                begin
+                  { Get in hp2 the replacer for the root or hasharr }
+                  hp2:=hp.left;
+                  hp3:=hp.right;
+                  if not assigned(hp2) then
+                   begin
+                     hp2:=hp.right;
+                     hp3:=hp.left;
+                   end;
+                  { remove entry from the tree }
+                  if assigned(lasthp) then
+                   begin
+                     if lasthp.left=hp then
+                      lasthp.left:=hp2
+                     else
+                      lasthp.right:=hp2;
+                   end
+                  else
+                   begin
+                     if assigned(FHashArray) then
+                      FHashArray^[spdval mod hasharraysize]:=hp2
+                     else
+                      FRoot:=hp2;
+                   end;
+                  { reinsert the hp3 in the tree from hp2 }
+                  inserttree(hp3,hp2);
+                  { reset Node with New values }
+                  hp.name:=newS;
+                  hp.FSpeedValue:=GetSpeedValue(newS);
+                  hp.left:=nil;
+                  hp.right:=nil;
+                  { reinsert }
+                  if assigned(FHashArray) then
+                   rename:=insertNode(hp,FHashArray^[hp.SpeedValue mod hasharraysize])
+                  else
+                   rename:=insertNode(hp,FRoot);
+                  exit;
+                end
+               else
+                if olds>hp.name then
+                 begin
+                   lasthp:=hp;
+                   hp:=hp.left
+                 end
+                else
+                 begin
+                   lasthp:=hp;
+                   hp:=hp.right;
+                 end;
+             end;
+          end;
+      end;
+
+
+    function Tdictionary.search(const s:string):TDictionaryItem;
+      begin
+        search:=speedsearch(s,GetSpeedValue(s));
+      end;
+
+
+    function Tdictionary.speedsearch(const s:string;SpeedValue:integer):TDictionaryItem;
+      var
+        NewNode:TDictionaryItem;
+      begin
+        if assigned(FHashArray) then
+         NewNode:=FHashArray^[SpeedValue mod hasharraysize]
+        else
+         NewNode:=FRoot;
+        while assigned(NewNode) do
+         begin
+           if SpeedValue>NewNode.SpeedValue then
+            NewNode:=NewNode.left
+           else
+            if SpeedValue<NewNode.SpeedValue then
+             NewNode:=NewNode.right
+           else
+            begin
+              if (NewNode.name=s) then
+               begin
+                 speedsearch:=NewNode;
+                 exit;
+               end
+              else
+               if s>NewNode.name then
+                NewNode:=NewNode.left
+              else
+               NewNode:=NewNode.right;
+            end;
+         end;
+        speedsearch:=nil;
+      end;
+
+
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-01-24 21:59:36  peter
+    * first commit of new fpcmake
+
+}

utils/fpcm/fpcmmain.pp

@@ -0,0 +1,828 @@
+{
+    $Id$
+    Copyright (c) 2001 by Peter Vreman
+
+    FPCMake - Main module
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$ifdef fpc}{$mode objfpc}{$endif}
+{$H+}
+unit fpcmmain;
+interface
+
+    uses
+      sysutils,classes,
+      fpcmdic;
+
+    const
+      Version='v1.99.0';
+      Title='fpcmake '+Version;
+      TitleDate=Title+' ['+{$ifdef fpc}{$i %DATE}{$else}'n/a'{$endif}+']';
+    type
+      TTarget=(t_all,
+        t_linux,t_go32v2,t_win32,t_os2,t_freebsd
+      );
+
+    const
+      TargetStr : array[TTarget] of string=('all',
+        'linux','go32v2','win32','os2','freebsd'
+      );
+
+      TargetSuffix : array[TTarget] of string=('',
+        '_linux','_go32v2','_win32','_os2','_freebsd'
+      );
+
+
+    type
+      TKeyValueItem = class(TDictionaryItem)
+      private
+        FValue : string;
+      public
+        constructor Create(const k,v:string);
+        property Value:string read FValue write FValue;
+      end;
+
+      TKeyValue = class(TDictionary)
+      private
+        function GetKey(const k:string):string;
+      public
+        procedure Add(const k,v:String);
+        property Key[const s:string]:string read GetKey;default;
+      end;
+
+      TFPCMakeSection = class(TDictionaryItem)
+      private
+        FList       : TStringList;
+        FDictionary : TKeyValue;
+        procedure PrintDic(p:TDictionaryItem);
+        procedure BuildIniDic(p:TDictionaryItem);
+        procedure BuildMakefileDic(p:TDictionaryItem);
+        function GetKey(const k:string):string;
+      public
+        constructor Create(const n:string);
+        constructor CreateKeyValue(const n:string);
+        destructor  Destroy;override;
+        procedure AddLine(const s:string);
+        procedure AddKey(const k,v:string);
+        procedure ParseIni;
+        procedure BuildIni;
+        procedure BuildMakefile;
+        procedure Print;
+        property Key[const s:string]:string read GetKey;default;
+        property List:TStringList read FList;
+        property Dictionary:TKeyValue read FDictionary;
+      end;
+
+      TFPCMake = class
+      private
+        FStream         : TStream;
+        FFileName       : string;
+        FCommentChars   : TSysCharSet;
+        FEmptyLines     : boolean;
+        FSections       : TDictionary;
+        FPackageSec,
+        FExportSec      : TFPCMakeSection;
+        FPackageName,
+        FPackageVersion : string;
+        FRequireList    : TStringList;
+        FVariables      : TKeyValue;
+        procedure Init;
+        procedure ParseSec(p:TDictionaryItem);
+        procedure PrintSec(p:TDictionaryItem);
+        function  GetSec(const AName:string):TDictionaryItem;
+      public
+        constructor Create(const AFileName:string);
+        constructor CreateFromStream(s:TStream;const AFileName:string);
+        destructor  Destroy;override;
+        procedure LoadSections;
+        procedure LoadMakefileFPC;
+        procedure LoadPackageSection;
+        procedure LoadRequiredPackage(const ReqName,ReqVersion:string);
+        procedure LoadRequires(FromFPCMake:TFPCMake);
+        function  GetTargetRequires(t:TTarget):TStringList;
+        procedure CreateExportSection;
+        procedure SubstVariables(var s:string);
+        function  GetVariable(const inivar:string):string;
+        procedure Print;
+        property Section[const s:string]:TDictionaryItem read GetSec;default;
+        property RequireList:TStringList read FRequireList;
+        property Variables:TKeyValue read FVariables;
+        property PackageName:string read FPackageName;
+        property PackageVersion:string read FPackageVersion;
+        property PackageSec:TFPCMakeSection read FPackageSec;
+        property ExportSec:TFPCMakeSection read FExportSec;
+        property CommentChars:TSysCharSet read FCommentChars write FCommentChars;
+        property EmptyLines:Boolean read FEmptyLines write FEmptyLines;
+      end;
+
+    function posidx(const substr,s : string;idx:integer):integer;
+
+
+implementation
+
+    resourcestring
+      s_not_list_sec='Not a list section "%s"';
+      s_not_key_value_sec='Not a key-value section "%s"';
+      s_err_section_start='%s:%d: Wrong section start';
+      s_err_not_key_value='Parse error key=value excepted: "%s"';
+      s_err_no_section='%s:%d: Entries without section';
+      s_no_package_section='No package section found';
+      s_no_package_name='No package name set';
+      s_no_package_version='No package version set';
+      s_err_require_format='Wrong require format "%s"';
+
+    type
+      tspecialdir=record
+        dir,unitdir,packdir : string;
+      end;
+
+    const
+      specialdirs = 4;
+      specialdir : array[1..specialdirs] of tspecialdir=(
+        (dir: 'rtl';  unitdir: '$(UNITSDIR)/rtl';  packdir: '$(FPCDIR)/rtl'),
+        (dir: 'fcl';  unitdir: '$(UNITSDIR)/fcl';  packdir: '$(FPCDIR)/fcl'),
+        (dir: 'api';  unitdir: '$(UNITSDIR)/api';  packdir: '$(FPCDIR)/api'),
+        (dir: 'fv';   unitdir: '$(UNITSDIR)/fv';   packdir: '$(FPCDIR)/fv')
+      );
+
+{****************************************************************************
+                                 Helpers
+****************************************************************************}
+
+    Function PathExists ( F : String) : Boolean;
+      Var
+        Info : TSearchRec;
+      begin
+        if F[Length(f)] in ['/','\'] then
+         Delete(f,length(f),1);
+        PathExists:=(findfirst(F,fareadonly+faarchive+fahidden+fadirectory,info)=0) and
+                    ((info.attr and fadirectory)=fadirectory);
+        findclose(Info);
+      end;
+
+
+    function posidx(const substr,s : string;idx:integer):integer;
+      var
+        i,j : integer;
+        e   : boolean;
+      begin
+        i:=idx;
+        j:=0;
+        e:=(length(SubStr)>0);
+        while e and (i<=Length(s)-Length(SubStr)) do
+         begin
+           inc(i);
+           if (SubStr[1]=s[i]) and (Substr=Copy(s,i,Length(SubStr))) then
+            begin
+              j:=i;
+              e:=false;
+            end;
+         end;
+        PosIdx:=j;
+      end;
+
+
+
+{****************************************************************************
+                               TKeyValueItem
+****************************************************************************}
+
+    constructor TKeyValueItem.Create(const k,v:string);
+      begin
+        inherited Create(k);
+        value:=v;
+      end;
+
+
+{****************************************************************************
+                                 TKeyValue
+****************************************************************************}
+
+    function TKeyValue.GetKey(const k:string):string;
+      var
+        p : TKeyValueItem;
+      begin
+        p:=TKeyValueItem(Search(k));
+        if p=nil then
+         GetKey:=''
+        else
+         GetKey:=p.Value;
+      end;
+
+
+    procedure TKeyValue.Add(const k,v:string);
+      begin
+        Insert(TKeyValueItem.Create(k,v));
+      end;
+
+
+{****************************************************************************
+                               TFPCMakeSection
+****************************************************************************}
+
+    constructor TFPCMakeSection.Create(const n:string);
+      begin
+        inherited Create(n);
+        FList:=TStringList.Create;
+        FDictionary:=nil;
+      end;
+
+
+    constructor TFPCMakeSection.CreateKeyValue(const n:string);
+      begin
+        inherited Create(n);
+        FList:=nil;
+        FDictionary:=TKeyValue.Create;
+      end;
+
+
+    destructor TFPCMakeSection.Destroy;
+      begin
+        inherited Destroy;
+        FList.Free;
+        FDictionary.Free;
+      end;
+
+
+    procedure TFPCMakeSection.AddLine(const s:string);
+      begin
+        if FList=nil then
+         raise Exception.Create(Format(s_not_list_sec,[Name]));
+        FList.Add(s);
+      end;
+
+
+    procedure TFPCMakeSection.AddKey(const k,v:string);
+      begin
+        if FDictionary=nil then
+         raise Exception.Create(Format(s_not_key_value_sec,[Name]));
+        { Don't add empty values }
+        if v<>'' then
+         FDictionary.Add(k,v);
+      end;
+
+
+    procedure TFPCMakeSection.PrintDic(p:TDictionaryItem);
+      begin
+        with TKeyValueItem(p) do
+         begin
+           writeln('   ',name,' = "',value,'"');
+         end;
+      end;
+
+
+    function TFPCMakeSection.GetKey(const k:string):string;
+      begin
+        if FDictionary=nil then
+         raise Exception.Create(Format(s_not_key_value_sec,[Name]));
+        GetKey:=FDictionary[k];
+      end;
+
+
+    procedure TFPCMakeSection.Print;
+      var
+        i : integer;
+      begin
+        writeln('[',Name,']');
+        if assigned(FList) then
+         begin
+           writeln('  List:');
+           for i:=0 to FList.Count-1 do
+            Writeln('   "'+FList[i],'"');
+           if assigned(FDictionary) then
+            writeln('');
+         end;
+        if assigned(FDictionary) then
+         begin
+           writeln('  Dictionary:');
+           FDictionary.Foreach(@PrintDic);
+         end;
+      end;
+
+
+    procedure TFPCMakeSection.ParseIni;
+      var
+        p : TKeyValueItem;
+        i,j,len,maxi : integer;
+        s,newkey,value : string;
+      begin
+        { If already processed skip }
+        if assigned(FDictionary) then
+         exit;
+        { Don't process rules section }
+        if (Name='rules') then
+         exit;
+        { Parse the section }
+        FDictionary:=TKeyValue.Create;
+        { Parse the list }
+        maxi:=FList.Count;
+        i:=0;
+        while (i<maxi) do
+         begin
+           s:=Trim(FList[i]);
+           len:=Length(s);
+           { Concat lines ending with \ }
+           while s[len]='\' do
+            begin
+              Delete(s,len,1);
+              if i+1<maxi then
+               begin
+                 inc(i);
+                 s:=s+Trim(FList[i]);
+                 len:=Length(s);
+               end;
+            end;
+           { Parse key=value line }
+           j:=0;
+           while (j<len) and (s[j+1] in ['A'..'Z','a'..'z','0'..'9','_']) do
+            inc(j);
+           NewKey:=Copy(s,1,j);
+           While (j<len) and (s[j+1] in [' ',#9]) do
+            inc(j);
+           inc(j);
+           if s[j]<>'=' then
+            Raise Exception.Create(Format(s_err_not_key_value,[s]));
+           While (j<len) and (s[j+1] in [' ',#9]) do
+            inc(j);
+           if j=len then
+            Raise Exception.Create(Format(s_err_not_key_value,[s]));
+           Value:=Copy(s,j+1,len-j);
+           p:=TKeyValueItem(FDictionary[NewKey]);
+           { Concat values if key already exists }
+           if assigned(p) then
+            p.Value:=p.Value+' '+Value
+           else
+            FDictionary.Add(NewKey,Value);
+           inc(i);
+         end;
+        { List is not used anymore }
+        FList.Free;
+        FList:=nil;
+      end;
+
+
+
+    procedure TFPCMakeSection.BuildIniDic(p:TDictionaryItem);
+      begin
+        with TKeyValueItem(p) do
+         begin
+           FList.Add(Name+'='+Value);
+         end;
+      end;
+
+
+    procedure TFPCMakeSection.BuildIni;
+      begin
+        if assigned(FList) then
+         exit;
+        FList:=TStringList.Create;
+        FDictionary.Foreach(@BuildIniDic);
+        FDictionary.Free;
+        FDictionary:=nil;
+      end;
+
+
+    procedure TFPCMakeSection.BuildMakefileDic(p:TDictionaryItem);
+      begin
+        FList.Add(Uppercase(Name+'_'+TKeyValueItem(p).Name)+'='+TKeyValueItem(p).Value);
+      end;
+
+
+    procedure TFPCMakeSection.BuildMakefile;
+      begin
+        if assigned(FList) then
+         exit;
+        FList:=TStringList.Create;
+        FDictionary.Foreach(@BuildMakefileDic);
+        FDictionary.Free;
+        FDictionary:=nil;
+      end;
+
+
+{****************************************************************************
+                                   TFPCMake
+****************************************************************************}
+
+    constructor TFPCMake.Create(const AFileName:string);
+      begin
+        FFileName:=AFileName;
+        FStream:=nil;
+        Init;
+      end;
+
+
+    constructor TFPCMake.CreateFromStream(s:TStream;const AFileName:string);
+      begin
+        FFileName:=AFileName;
+        FStream:=s;
+        Init;
+      end;
+
+
+    procedure TFPCMake.Init;
+      begin
+        FSections:=TDictionary.Create;
+        FRequireList:=TStringList.Create;
+        FVariables:=TKeyValue.Create;
+        FCommentChars:=[';','#'];
+        FEmptyLines:=false;
+        FPackageName:='';
+        FPackageVersion:='';
+        FPackageSec:=nil;
+        FExportSec:=nil;
+      end;
+
+
+    destructor TFPCMake.Destroy;
+      begin
+        FSections.Free;
+        FRequireList.Free;
+        FVariables.Free;
+      end;
+
+
+    procedure TFPCMake.LoadSections;
+      var
+        SLInput : TStringList;
+        i,j,n : integer;
+        s,
+        SecName : string;
+        CurrSec : TFPCMakeSection;
+      begin
+        try
+          SLInput:=TStringList.Create;
+          if assigned(FStream) then
+           SLInput.LoadFromStream(FStream)
+          else
+           SLInput.LoadFromFile(FFileName);
+          { Load Input into sections list }
+          n:=SLInput.Count;
+          i:=0;
+          while (i<n) do
+           begin
+             s:=Trim(SLInput[i]);
+             if (EmptyLines and (s='')) or
+                ((s<>'') and not(s[1] in FCommentChars)) then
+              begin
+                { section start? }
+                if (s<>'') and (s[1]='[') then
+                 begin
+                   j:=pos(']',s);
+                   if j=0 then
+                    raise Exception.Create(Format(s_err_section_start,[FFileName,i]));
+                   SecName:=Copy(s,2,j-2);
+                   CurrSec:=TFPCMakeSection(FSections[SecName]);
+                   if CurrSec=nil then
+                    CurrSec:=TFPCMakeSection(FSections.Insert(TFPCMakeSection.Create(SecName)));
+                 end
+                else
+                 begin
+                   if CurrSec=nil then
+                    raise Exception.Create(Format(s_err_no_section,[FFileName,i]));
+                   { Insert string without spaces stripped }
+                   CurrSec.AddLine(SLInput[i]);
+                 end;
+              end;
+             inc(i);
+           end;
+        finally
+          SLInput.Free;
+        end;
+      end;
+
+
+    procedure TFPCMake.LoadMakefileFPC;
+      begin
+        LoadSections;
+        { Parse all sections }
+        FSections.Foreach(@ParseSec);
+      end;
+
+
+    procedure TFPCMake.LoadPackageSection;
+      begin
+        { Get package info from package section }
+        FPackageSec:=TFPCMakeSection(FSections['package']);
+        if FPackageSec=nil then
+         begin
+           Writeln('Note: no package section');
+           exit;
+         end;
+        { Parse the section to key=value pairs }
+        FPackageSec.ParseIni;
+        { mandatory name }
+        FPackageName:=FPackageSec['name'];
+        if FPackageName='' then
+         Raise Exception.Create(s_no_package_name);
+        { mandatory version }
+        FPackageVersion:=FPackageSec['version'];
+        if FPackageVersion='' then
+         Raise Exception.Create(s_no_package_version);
+        { Set the ExportSec }
+        FExportSec:=TFPCMakeSection(FSections[Lowercase(FPackageName)]);
+      end;
+
+
+    procedure TFPCMake.CreateExportSection;
+      var
+        t : TTarget;
+      begin
+        { Don't create a section twice }
+        if FExportSec<>nil then
+         exit;
+        { Look if we've already an own section, else create a new
+          key-value section }
+        FExportSec:=TFPCMakeSection(FSections[LowerCase(FPackageName)]);
+        if FExportSec=nil then
+         FExportSec:=TFPCMakeSection(FSections.Insert(TFPCMakeSection.CreateKeyValue(LowerCase(FPackageName))));
+        { Add default the values to the export section }
+        FExportSec.AddKey('name',FPackageName);
+        FExportSec.AddKey('version',FPackageVersion);
+        { Add required packages }
+        for t:=low(TTarget) to high(TTarget) do
+         FExportSec.AddKey('require'+TargetSuffix[t],FPackageSec['require'+TargetSuffix[t]]);
+        { Unit dir }
+        {FExportSec.AddKey('unitdir','$(UNITSDIR)/'+Lowercase(PackageName));}
+      end;
+
+
+    procedure TFPCMake.LoadRequiredPackage(const ReqName,ReqVersion:string);
+
+        function TryFile(const fn:string):boolean;
+        var
+          ReqFPCMake : TFPCMake;
+          HList : TStringList;
+          NewSec,ReqSec,Sec : TFPCMakeSection;
+        begin
+          TryFile:=false;
+          if FileExists(fn) then
+           begin
+             writeln('Package ',ReqName,': ',fn);
+
+             ReqFPCMake:=TFPCMake.Create(fn);
+             ReqFPCMake.LoadMakefileFPC;
+             ReqFPCMake.LoadPackageSection;
+             { Check package name and version }
+             if LowerCase(ReqFPCMake.PackageName)<>ReqName then
+              raise Exception.Create('s_wrong_package_name');
+             if (ReqVersion<>'') and (ReqFPCMake.PackageVersion<ReqVersion) then
+              raise Exception.Create('s_wrong_package_version');
+             { First load the requirements of this package }
+             LoadRequires(ReqFPCMake);
+             { Get a copy of the export section }
+             if assigned(ReqFPCMake.ExportSec) then
+              begin
+                ReqFPCMake.ExportSec.BuildIni;
+                NewSec:=TFPCMakeSection(FSections.Insert(TFPCMakeSection.Create(ReqName)));
+                NewSec.List.AddStrings(ReqFPCMake.ExportSec.List);
+                NewSec.ParseIni;
+              end;
+             { Get a copy of the require section }
+             ReqSec:=TFPCMakeSection(ReqFPCMake['require']);
+             if assigned(ReqSec) then
+              begin
+                ReqSec.BuildIni;
+                NewSec:=TFPCMakeSection(FSections.Insert(TFPCMakeSection.Create(ReqName+'_require')));
+                NewSec.List.AddStrings(ReqSec.List);
+                NewSec.ParseIni;
+              end;
+             { Free }
+             ReqFPCMake.Free;
+             TryFile:=true;
+           end;
+        end;
+
+      var
+        s : string;
+        i : integer;
+      begin
+        writeln(ReqName,' - ',ReqVersion);
+
+        s:='$(PACKAGESDIR)/'+ReqName;
+        For i:=1 to SpecialDirs do
+         if SpecialDir[i].Dir=ReqName then
+          begin
+            s:=SpecialDir[i].PackDir;
+            break;
+          end;
+        SubstVariables(s);
+        if TryFile(s+'/Makefile.fpc') then
+         exit;
+        Raise Exception.Create('s_package_not_found');
+      end;
+
+
+    procedure TFPCMake.LoadRequires(FromFPCMake:TFPCMake);
+      var
+        s,
+        ReqName,
+        ReqVersion : string;
+        i,j : integer;
+        t : TTarget;
+        Sec : TFPCMakeSection;
+      begin
+        Sec:=TFPCMakeSection(FromFPCMake['require']);
+        if Sec=nil then
+         exit;
+        for t:=low(TTarget) to high(TTarget) do
+         begin
+           s:=Sec['packages'+TargetSuffix[t]];
+           repeat
+             i:=pos(' ',s);
+             if i=0 then
+              begin
+                ReqName:=Trim(s);
+                s:='';
+              end
+             else
+              begin
+                ReqName:=Trim(Copy(s,1,i));
+                Delete(s,1,i);
+                s:=TrimLeft(s);
+              end;
+             if ReqName<>'' then
+              begin
+                i:=Pos('(',ReqName);
+                if i>0 then
+                 begin
+                   j:=Pos(')',ReqName);
+                   if (i=1) or (j=0) then
+                    Raise Exception.Create(Format(s_err_require_format,[ReqName]));
+                   ReqVersion:=Copy(ReqName,i+1,j-i-1);
+                   ReqName:=Copy(ReqName,1,i-1);
+                 end
+                else
+                 ReqVersion:='';
+                { We only use lowercase names }
+                ReqName:=Lowercase(ReqName);
+                { Already loaded ? }
+                if not RequireList.Find(ReqName,i) then
+                 begin
+                   LoadRequiredPackage(ReqName,ReqVersion);
+                   RequireList.Add(ReqName);
+                 end;
+              end;
+           until s='';
+         end;
+        { Force an rtl dependency }
+        if not RequireList.Find('rtl',i) then
+         begin
+           LoadRequiredPackage('rtl','');
+           RequireList.Add('rtl');
+         end;
+      end;
+
+
+    function TFPCMake.GetTargetRequires(t:TTarget):TStringList;
+      var
+        ReqSec  : TFPCMakeSection;
+        ReqList : TStringList;
+
+        procedure AddReqSec(t:TTarget;Sec:TFPCMakeSection);
+        var
+          s,
+          ReqName : string;
+          RSec : TFPCMakeSection;
+          i,j : integer;
+        begin
+          s:=Sec['packages'+TargetSuffix[t]];
+          while s<>'' do
+           begin
+             i:=pos(' ',s);
+             if i=0 then
+              begin
+                ReqName:=Trim(s);
+                s:='';
+              end
+             else
+              begin
+                ReqName:=Trim(Copy(s,1,i));
+                Delete(s,1,i);
+                s:=TrimLeft(s);
+              end;
+             if ReqName<>'' then
+              begin
+                i:=Pos('(',ReqName);
+                if i>0 then
+                 ReqName:=Copy(ReqName,1,i-1);
+                { We only use lowercase names }
+                ReqName:=Lowercase(ReqName);
+                { Already loaded ? }
+                if not ReqList.Find(ReqName,i) then
+                 begin
+                   RSec:=TFPCMakeSection(FSections[ReqName+'_require']);
+                   if assigned(RSec) then
+                    begin
+                      { for packages we depend on always include the
+                        target and all keys }
+                      if t<>t_all then
+                       AddReqSec(t_all,RSec);
+                      AddReqSec(t,RSec);
+                    end;
+                   ReqList.Add(ReqName);
+                 end;
+              end;
+           end;
+        end;
+
+      begin
+        ReqList:=TStringList.Create;
+        ReqSec:=TFPCMakeSection(FSections['require']);
+        if assigned(ReqSec) then
+         AddReqSec(t,ReqSec);
+        GetTargetRequires:=ReqList;
+      end;
+
+
+    procedure TFPCMake.SubstVariables(var s:string);
+      var
+        i,j,k : integer;
+        s2,s3 : string;
+        Sec   : TFPCMakeSection;
+      begin
+        repeat
+          i:=Pos('$(',s);
+          if i=0 then
+           break;
+          j:=PosIdx(')',s,i+2);
+          s2:=Copy(s,i+2,j-i-2);
+          k:=pos('.',s2);
+          if k>0 then
+           begin
+             s3:=Copy(s2,k+1,Length(s2)-k);
+             s2:=Copy(s2,1,k-1);
+             Sec:=TFPCMakeSection(Section[s2]);
+             if assigned(Sec) then
+              s2:=Sec[s3]
+             else
+              s2:='';
+           end
+          else
+           s2:=Variables[s2];
+          Delete(s,i,j-i+1);
+          Insert(s2,s,i);
+        until false;
+      end;
+
+
+    function TFPCMake.GetVariable(const inivar:string):string;
+      var
+        Sec : TFPCMakeSection;
+        Dic : TKeyValue;
+        i   : integer;
+      begin
+        Result:='';
+        i:=Pos('.',inivar);
+        if i<>0 then
+         begin
+           Sec:=TFPCMakeSection(FSections[Copy(Inivar,1,i-1)]);
+           if assigned(Sec) then
+            begin
+              Dic:=TKeyValue(Sec.Dictionary);
+              Result:=Dic[Copy(IniVar,i+1,Length(IniVar)-i)];
+            end
+           else
+            exit;
+         end
+        else
+         Result:=Variables[IniVar];
+      end;
+
+
+    procedure TFPCMake.ParseSec(p:TDictionaryItem);
+      begin
+        TFPCMakeSection(p).ParseIni;
+      end;
+
+
+    procedure TFPCMake.PrintSec(p:TDictionaryItem);
+      begin
+        TFPCMakeSection(p).Print;
+      end;
+
+
+    procedure TFPCMake.Print;
+      begin
+        FSections.Foreach(@PrintSec);
+      end;
+
+
+    function TFPCMake.GetSec(const AName:string):TDictionaryItem;
+      begin
+        GetSec:=FSections.Search(AName);
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-01-24 21:59:36  peter
+    * first commit of new fpcmake
+
+}

utils/fpcm/fpcmwr.pp

@@ -0,0 +1,713 @@
+{
+    $Id$
+    Copyright (c) 2001 by Peter Vreman
+
+    FPCMake - Makefile writer
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$ifdef fpc}{$mode objfpc}{$endif}
+{$H+}
+unit fpcmwr;
+interface
+
+    uses
+      sysutils,classes,
+      fpcmmain;
+
+    type
+      tsections=(sec_none,
+        sec_units,sec_exes,sec_loaders,sec_examples,
+        sec_compile,sec_install,sec_exampleinstall,
+        sec_zipinstall,sec_clean,sec_libs,
+        sec_command,sec_exts,sec_dirs,sec_tools,sec_info
+      );
+
+      tRules=(
+        r_all,r_debug,
+        r_examples,
+        r_smart,r_shared,
+        r_install,r_sourceinstall,r_exampleinstall,
+        r_zipinstall,r_zipsourceinstall,r_zipexampleinstall,
+        r_clean,r_distclean,r_cleanall,
+        r_info
+      );
+
+
+    const
+      rule2str : array[trules] of string=(
+        'all','debug',
+        'examples',
+        'smart','shared',
+        'install','sourceinstall','exampleinstall',
+        'zipinstall','zipsourceinstall','zipexampleinstall',
+        'clean','distclean','cleanall',
+        'info'
+      );
+
+      rule2sec : array[trules] of tsections=(
+        sec_compile,sec_compile,
+        sec_examples,
+        sec_libs,sec_libs,
+        sec_install,sec_install,sec_exampleinstall,
+        sec_zipinstall,sec_zipinstall,sec_zipinstall,
+        sec_clean,sec_clean,sec_clean,
+        sec_info
+      );
+
+
+
+    type
+      TMakefileWriter=class
+      private
+        FFileName : string;
+        FIni    : TFPCMake;
+        FInput  : TFPCMake;
+        FOutput : TStringList;
+        FPhony  : string;
+        FHasSection : array[tsections] of boolean;
+        procedure LoadFPCMakeIni;
+        procedure AddIniSection(const s:string);
+        procedure AddCustomSection(const s:string);
+        procedure AddTargetVariable(const inivar:string);
+        procedure AddVariable(const inivar:string);
+        function  AddTargetDefines(const inivar,prefix:string):string;
+        procedure AddRequiredPackages;
+        procedure AddTool(const exename:string);
+        procedure AddRules;
+        procedure AddPhony(const s:string);
+        procedure WritePhony;
+        procedure AddTargetDirs(const inivar:string);
+        function  CheckTargetVariable(const inivar:string):boolean;
+        function  CheckVariable(const inivar:string):boolean;
+      public
+        constructor Create(AFPCMake:TFPCMake;const AFileName:string);
+        destructor  Destroy;override;
+        procedure WriteGenericMakefile;
+      end;
+
+
+implementation
+
+{$i fpcmake.inc}
+
+    type
+      TMyMemoryStream=class(TMemoryStream)
+      public
+        constructor Create(p:pointer;mysize:integer);
+      end;
+
+
+{*****************************************************************************
+                               Helpers
+*****************************************************************************}
+
+    function FixVariable(s:string):string;
+      var
+        i : integer;
+      begin
+        Result:=UpperCase(s);
+        i:=pos('.',Result);
+        if i>0 then
+         Result[i]:='_';
+      end;
+
+
+    function VarName(const s:string):string;
+      var
+        i,j : longint;
+      begin
+        i:=0;
+        result:=s;
+        while i<length(result) do
+         begin
+           inc(i);
+           case result[i] of
+             '{' :
+               begin
+                 { this are pkgs which are hold the dirs between the accolades }
+                 j:=PosIdx('}',result,i);
+                 if j>0 then
+                  Delete(result,i,j-i+1)
+                 else
+                  Delete(result,i,1);
+                 dec(i);
+               end;
+             '$','(',')' :
+               begin
+                 Delete(result,i,1);
+                 dec(i);
+               end;
+             'a'..'z' :
+               result[i]:=chr(ord(result[i])-32);
+           end;
+         end;
+      end;
+
+
+    procedure AddStrNoDup(var s:string;const s2:string);
+      var
+        i,idx : longint;
+        again,add : boolean;
+      begin
+        add:=false;
+        idx:=0;
+        repeat
+          again:=false;
+          i:=posidx(s2,s,idx);
+          if (i=0) then
+           add:=true
+          else
+           if (i=1) then
+            begin
+              if (length(s)>length(s2)) and
+                 (s[length(s2)+1]<>' ') then
+               add:=true;
+            end
+          else
+           if (i>1) and
+              ((s[i-1]<>' ') or
+               ((length(s)>=i+length(s2)) and (s[i+length(s2)]<>' '))) then
+            begin
+              idx:=i+length(s2);
+              again:=true;
+            end;
+        until not again;
+        if add then
+         begin
+           if s='' then
+            s:=s2
+           else
+            s:=s+' '+s2;
+         end;
+      end;
+    procedure FixTab(sl:TStringList);
+      var
+        i,j,k : integer;
+        s,s2  : string;
+      begin
+        i:=0;
+        while (i<sl.Count) do
+         begin
+           if (sl[i]<>'') and (sl[i][1] in [' ',#9]) then
+            begin
+              s:=sl[i];
+              k:=0;
+              j:=0;
+              repeat
+                inc(j);
+                case s[j] of
+                  ' ' :
+                    inc(k);
+                  #9 :
+                    k:=(k+7) and not(7);
+                  else
+                    break;
+                end;
+              until (j=length(s));
+              if k>7 then
+               begin
+                 s2:='';
+                 Delete(s,1,j-1);
+                 while (k>7) do
+                  begin
+                    s2:=s2+#9;
+                    dec(k,8);
+                  end;
+                 while (k>0) do
+                  begin
+                    s2:=s2+' ';
+                    dec(k);
+                  end;
+                 sl[i]:=s2+s;
+               end;
+            end;
+           inc(i);
+         end;
+      end;
+
+
+{*****************************************************************************
+                               TMyMemoryStream
+*****************************************************************************}
+
+    constructor TMyMemoryStream.Create(p:pointer;mysize:integer);
+      begin
+        inherited Create;
+        SetPointer(p,mysize);
+      end;
+
+
+{*****************************************************************************
+                               TMyMemoryStream
+*****************************************************************************}
+
+    constructor TMakefileWriter.Create(AFPCMake:TFPCMake;const AFileName:string);
+      begin
+        FInput:=AFPCMake;
+        FFileName:=AFileName;
+        FOutput:=TStringList.Create;
+        FPhony:='';
+        FillChar(FHasSection,sizeof(FHasSection),1);
+        LoadFPCMakeIni;
+      end;
+
+
+    destructor TMakefileWriter.Destroy;
+      begin
+        FOutput.Free;
+        FIni.Free;
+      end;
+
+
+    procedure TMakefileWriter.LoadFPCMakeIni;
+      var
+        IniStream : TStream;
+      begin
+        try
+          IniStream:=TMyMemoryStream.Create(@fpcmakeini,sizeof(fpcmakeini));
+          FIni:=TFPCMake.CreateFromStream(IniStream,'fpcmake.ini');
+          { Leave the '#' comments in the output }
+//          FIni.CommentChars:=[';'];
+          FIni.LoadSections;
+        finally
+          IniStream.Destroy;
+        end;
+      end;
+
+
+    procedure TMakefileWriter.AddIniSection(const s:string);
+      var
+        Sec : TFPCMakeSection;
+      begin
+        Sec:=TFPCMakeSection(FIni[s]);
+        if assigned(Sec) then
+         FOutput.AddStrings(Sec.List)
+        else
+         Raise Exception.Create(Format('Section "%s" doesn''t exists in fpcmake.ini',[s]));
+      end;
+
+
+    procedure TMakefileWriter.AddCustomSection(const s:string);
+      var
+        Sec : TFPCMakeSection;
+      begin
+        Sec:=TFPCMakeSection(FInput[s]);
+        if assigned(Sec) then
+         begin
+           Sec.BuildMakefile;
+           FOutput.AddStrings(Sec.List);
+         end;
+      end;
+
+
+    function TMakefileWriter.CheckTargetVariable(const inivar:string):boolean;
+      var
+        t : TTarget;
+      begin
+        result:=false;
+        for t:=low(TTarget) to high(TTarget) do
+         if FInput.GetVariable(IniVar+TargetSuffix[t])<>'' then
+          begin
+            result:=true;
+            exit;
+          end;
+      end;
+
+
+    function TMakefileWriter.CheckVariable(const inivar:string):boolean;
+      begin
+        Result:=(FInput.GetVariable(IniVar)<>'');
+      end;
+
+
+    procedure TMakefileWriter.AddTargetVariable(const inivar:string);
+      var
+        s : string;
+        T : TTarget;
+      begin
+        for t:=low(TTarget) to high(TTarget) do
+         begin
+           s:=FInput.GetVariable(IniVar+TargetSuffix[t]);
+           if s<>'' then
+            begin
+              if t<>t_all then
+               FOutput.Add('ifeq ($(OS_TARGET),'+TargetStr[t]+')');
+              FOutput.Add('override '+FixVariable(IniVar)+'+='+s);
+              if t<>t_all then
+               FOutput.Add('endif');
+            end;
+         end;
+      end;
+
+
+    procedure TMakefileWriter.AddVariable(const inivar:string);
+      var
+        s : string;
+      begin
+        s:=FInput.GetVariable(IniVar);
+        if s<>'' then
+         FOutput.Add('override '+FixVariable(IniVar)+'='+s)
+      end;
+
+
+    function TMakefileWriter.AddTargetDefines(const inivar,prefix:string):string;
+      var
+        s : string;
+        T : TTarget;
+        name : string;
+        i,k1,k2 : integer;
+      begin
+        result:='';
+        for t:=low(TTarget) to high(TTarget) do
+         begin
+           s:=FInput.GetVariable(IniVar+TargetSuffix[t]);
+           while (s<>'') do
+            begin
+              i:=pos(' ',s);
+              if i=0 then
+               i:=length(s)+1;
+              name:=Copy(s,1,i-1);
+              s:=TrimLeft(Copy(s,i+1,Length(s)-i));
+              { Remove (..) }
+              k1:=pos('(',name);
+              if k1>0 then
+               begin
+                 k2:=PosIdx(')',name,k1);
+                 if k2=0 then
+                  k2:=length(name)+1;
+                 Delete(Name,k1,k2);
+               end;
+              FOutput.Add(prefix+VarName(name)+'=1');
+              { add to the list of dirs without duplicates }
+              AddStrNoDup(result,name);
+            end;
+         end;
+      end;
+
+
+    procedure TMakefileWriter.AddTool(const exename:string);
+      var
+        varname : string;
+      begin
+        with FOutput do
+         begin
+           varname:=FixVariable(exename);
+           Add('ifndef '+varname);
+           Add(varname+':=$(strip $(wildcard $(addsuffix /'+exename+'$(SRCEXEEXT),$(SEARCHPATH))))');
+           Add('ifeq ($('+varname+'),)');
+           Add(varname+'=');
+           Add('else');
+           Add(varname+':=$(firstword $('+varname+'))');
+           Add('endif');
+           Add('endif');
+           Add('export '+varname);
+         end;
+      end;
+
+
+    procedure TMakefileWriter.AddRules;
+
+        procedure AddRule(rule:trules);
+        var
+          i : integer;
+          hs : string;
+          Sec : TFPCMakeSection;
+          Rules : TStringList;
+        begin
+          Sec:=TFPCMakeSection(FInput['rules']);
+          if assigned(Sec) then
+           begin
+             Rules:=Sec.List;
+             for i:=0 to Rules.Count-1 do
+              begin
+                if (length(rules[i])>length(rule2str[rule])) and
+                   (rules[i][1]=rule2str[rule][1]) and
+                   ((rules[i][length(rule2str[rule])+1]=':') or
+                    ((length(rules[i])>length(rule2str[rule])+1) and
+                     (rules[i][length(rule2str[rule])+2]=':'))) and
+                   (Copy(rules[i],1,length(rule2str[rule]))=rule2str[rule]) then
+                  exit;
+              end;
+           end;
+          hs:='';
+          if FHasSection[Rule2Sec[rule]] then
+           hs:=hs+' fpc_'+rule2str[rule];
+          { include target dirs }
+          if CheckTargetVariable('target.dirs') then
+           begin
+             if not(rule in [r_sourceinstall,r_zipinstall,r_zipsourceinstall]) or
+                not(CheckVariable('package.name')) then
+              hs:=hs+' $(addsuffix _'+rule2str[rule]+',$(TARGET_DIRS))';
+           end;
+          { include cleaning of example dirs }
+          if (rule=r_clean) and
+             CheckTargetVariable('target.exampledirs') then
+           hs:=hs+' $(addsuffix _'+rule2str[rule]+',$(TARGET_EXAMPLEDIRS))';
+          if hs<>'' then
+           begin
+             AddPhony(Rule2Str[Rule]);
+             FOutput.Add(rule2str[rule]+':'+hs);
+           end;
+        end;
+
+      var
+        rule : trules;
+      begin
+        for rule:=low(trules) to high(trules) do
+         AddRule(rule);
+        WritePhony;
+      end;
+
+    procedure TMakefileWriter.AddPhony(const s:string);
+      begin
+        FPhony:=FPhony+' '+s;
+      end;
+
+
+    procedure TMakefileWriter.WritePhony;
+      begin
+        if FPhony<>'' then
+         begin
+           FOutput.Add('.PHONY:'+FPhony);
+           FPhony:='';
+         end;
+      end;
+
+
+    procedure TMakefileWriter.AddTargetDirs(const inivar:string);
+
+        procedure AddTargetDir(const s,defpref:string);
+        var
+          j  : trules;
+        begin
+          FOutput.Add('ifdef '+defpref+VarName(s));
+          for j:=low(trules) to high(trules) do
+           begin
+             FOutput.Add(s+'_'+rule2str[j]+':');
+             FOutput.Add(#9+'$(MAKE) -C '+s+' '+rule2str[j]);
+             AddPhony(rule2str[j]);
+           end;
+          WritePhony;
+          FOutput.Add('endif');
+        end;
+
+      var
+        i  : integer;
+        hs : string;
+        prefix : string;
+      begin
+        prefix:=FixVariable(inivar)+'_';
+        hs:=AddTargetDefines(inivar,prefix);
+        while hs<>'' do
+         begin
+           i:=pos(' ',hs);
+           if i=0 then
+            i:=length(hs)+1;
+           AddTargetDir(Copy(hs,1,i-1),prefix);
+           delete(hs,1,i);
+         end;
+      end;
+
+
+    procedure TMakefileWriter.AddRequiredPackages;
+
+        procedure AddPackage(const pack,prefix:string);
+        var
+          packdirvar,unitdirvar : string;
+        begin
+          FOutput.Add('ifdef '+Prefix+VarName(pack));
+          { create needed variables }
+          packdirvar:='PACKAGEDIR_'+VarName(pack);
+          unitdirvar:='UNITDIR_'+VarName(pack);
+          { Search packagedir by looking for Makefile.fpc }
+          FOutput.Add(packdirvar+':=$(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /'+pack+'/$(OS_TARGET)/Makefile.fpc,$(PACKAGESDIR)))))');
+          FOutput.Add('ifeq ($('+packdirvar+'),)');
+          FOutput.Add(packdirvar+':=$(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /'+pack+'/Makefile.fpc,$(PACKAGESDIR)))))');
+          FOutput.Add('ifeq ($('+packdirvar+'),)');
+          FOutput.Add(packdirvar+'=');
+          FOutput.Add('else');
+          FOutput.Add(packdirvar+':=$(firstword $('+packdirvar+'))');
+          FOutput.Add('endif');
+          FOutput.Add('else');
+          FOutput.Add(packdirvar+':=$(firstword $('+packdirvar+'))');
+          FOutput.Add('endif');
+          { If Packagedir found look for FPCMade }
+          FOutput.Add('ifdef '+packdirvar);
+          FOutput.Add('ifeq ($(wildcard $('+packdirvar+')/$(FPCMADE)),)');
+          FOutput.Add('override COMPILEPACKAGES+=package_'+pack);
+          AddPhony('package_'+pack);
+          FOutput.Add('package_'+pack+':');
+          FOutput.Add(#9'$(MAKE) -C $('+packdirvar+') all');
+          FOutput.Add('endif');
+          FOutput.Add(unitdirvar+'=$('+packdirvar+')');
+          { Package dir doesn''t exists, use unit dir }
+          FOutput.Add('else');
+          FOutput.Add(packdirvar+'=');
+          FOutput.Add(unitdirvar+':=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /'+pack+'/Package.fpc,$(UNITSDIR)))))');
+          FOutput.Add('ifeq ($('+unitdirvar+'),)');
+          FOutput.Add(unitdirvar+'=');
+          FOutput.Add('else');
+          FOutput.Add(unitdirvar+':=$(firstword $('+unitdirvar+'))');
+          FOutput.Add('endif');
+          FOutput.Add('endif');
+          { Add Unit dir to the command line -Fu }
+          FOutput.Add('ifdef '+unitdirvar);
+          FOutput.Add('override COMPILER_UNITDIR+=$('+unitdirvar+')');
+          FOutput.Add('endif');
+          { endif for package }
+          FOutput.Add('endif');
+        end;
+
+      var
+        i  : integer;
+        hs : string;
+        prefix : string;
+        t : Ttarget;
+        sl : TStringList;
+      begin
+        prefix:='REQUIRE_PACKAGES_';
+        { Add target defines }
+        for t:=low(ttarget) to high(ttarget) do
+         begin
+           sl:=FInput.GetTargetRequires(t);
+           if sl.count>0 then
+            begin
+              writeln(TargetStr[t]+' requires:');
+              if t<>t_all then
+               FOutput.Add('ifeq ($(OS_TARGET),'+TargetStr[t]+')');
+              for i:=0 to sl.count-1 do
+               begin
+                 FOutput.Add(prefix+VarName(sl[i])+'=1');
+                 writeln(sl[i]);
+               end;
+              if t<>t_all then
+               FOutput.Add('endif');
+            end;
+           sl.Free;
+         end;
+        { Add all require packages }
+        for i:=0 to FInput.RequireList.Count-1 do
+         AddPackage(FInput.RequireList[i],prefix);
+        WritePhony;
+      end;
+
+    procedure TMakefileWriter.WriteGenericMakefile;
+      var
+        i : integer;
+        rule : trules;
+      begin
+        with FOutput do
+         begin
+           { Header }
+           Add('#');
+           Add('# Don''t edit, this file is generated by '+TitleDate);
+           Add('#');
+           Add('default: all');
+           { Add automatic detect sections }
+           AddIniSection('osdetect');
+           AddIniSection('fpcdetect');
+           AddIniSection('fpcdirdetect');
+           { Package }
+           AddVariable('package.name');
+           AddVariable('package.version');
+           { First add the required packages sections }
+           for i:=0 to FInput.RequireList.Count-1 do
+            AddCustomSection(FInput.Requirelist[i]);
+           { Targets }
+           AddTargetVariable('target.dirs');
+           AddTargetVariable('target.programs');
+           AddTargetVariable('target.units');
+           AddTargetVariable('target.rsts');
+           AddTargetVariable('target.examples');
+           AddTargetVariable('target.exampledirs');
+           { Clean }
+           AddTargetVariable('clean.units');
+           AddTargetVariable('clean.files');
+           { Install }
+           AddTargetVariable('install.units');
+           AddTargetVariable('install.files');
+           AddVariable('install.prefixdir');
+           AddVariable('install.basedir');
+           AddVariable('install.datadir');
+           { Dist }
+           AddVariable('dist.zipname');
+           AddVariable('dist.ziptarget');
+           { Compiler }
+           AddVariable('compiler.options');
+           AddVariable('compiler.version');
+           AddVariable('compiler.includedir');
+           AddVariable('compiler.sourcedir');
+           AddVariable('compiler.objectdir');
+           AddVariable('compiler.librarydir');
+           AddVariable('compiler.targetdir');
+           AddVariable('compiler.unittargetdir');
+           { Require packages }
+           AddRequiredPackages;
+           { default dirs/tools/extensions }
+           AddIniSection('shelltools');
+           AddIniSection('defaulttools');
+           AddIniSection('extensions');
+           AddIniSection('defaultdirs');
+           if CheckVariable('require.libc') then
+            AddIniSection('dirlibc');
+           { commandline }
+           AddIniSection('command_begin');
+           if CheckVariable('require.libc') then
+            AddIniSection('command_libc');
+           AddIniSection('command_end');
+           { compile }
+           if CheckTargetVariable('target.loaders') then
+            AddIniSection('loaderrules');
+           if CheckTargetVariable('target.units') then
+            AddIniSection('unitrules');
+           if CheckTargetVariable('target.programs') then
+            AddIniSection('exerules');
+           if CheckTargetVariable('target.rsts') then
+            AddIniSection('rstrules');
+           if CheckTargetVariable('target.examples') or
+              CheckTargetVariable('target.exampledirs') then
+            AddIniSection('examplerules');
+           AddIniSection('compilerules');
+           if CheckVariable('lib.name') then
+            AddIniSection('libraryrules');
+           { install }
+           AddIniSection('installrules');
+           if CheckTargetVariable('target.examples') or
+              CheckTargetVariable('target.exampledirs') then
+            AddIniSection('exampleinstallrules');
+           if CheckVariable('package.name') then
+            AddIniSection('zipinstallrules');
+           { clean }
+           AddIniSection('cleanrules');
+           { info }
+           AddIniSection('inforules');
+           { Subdirs }
+           AddTargetDirs('target.dirs');
+           AddTargetDirs('target.exampledirs');
+           { Rules }
+           AddRules;
+           { Users own rules }
+           AddIniSection('localmakefile');
+           AddIniSection('userrules');
+           if assigned(FInput['rules']) then
+            AddStrings(TFPCMakeSection(FInput['rules']).List);
+         end;
+        { write to disk }
+        Fixtab(FOutput);
+        FOutput.SaveToFile(FFileName);
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-01-24 21:59:36  peter
+    * first commit of new fpcmake
+
+}