* updated for 0.99.10

  * new end dialogbox

install/install.dos

@@ -4,7 +4,7 @@
 # Go32 Install file
 #
 title=Free Pascal Compiler for Go32v2
-version=0.99.8
+version=0.99.10
 
 basepath=c:\pp
 binsub=\bin\go32v2
@@ -16,14 +16,14 @@ package=gdbgo32.zip,GNU ~D~ebugger for Go32v2
 package=utilgo32.zip,GNU ~U~tilities (required to recompile run time library)
 package=demo.zip,D~e~mos
 package=docs-htm.zip,Documentation (~H~TML)
-package=rl0998s.zip,~R~un time library sources
-package=pp0998s.zip,~C~ompiler sources
+package=rl09910s.zip,~R~un time library sources
+package=pp09910s.zip,~C~ompiler sources
 package=doc110s.zip,Documentation sources (La~T~eX)
 
 cfgfile=ppc386.cfg
 defaultcfg=
 #
-# Example ppc386.cfg for Free Pascal Compiler Version 0.99.8
+# Example ppc386.cfg for Free Pascal Compiler Version 0.99.10
 #
 
 # ----------------------
@@ -81,10 +81,9 @@ defaultcfg=
 # -So   tries to be TP/BP 7.0 compatible
 # -Ss   constructor name must be init (destructor must be done)
 # -St   allows static keyword in objects
-# -Sv   allow CVAR variable directive
 
-# Allow goto, inline, C-operators, CVar directive
--Sgicv
+# Allow goto, inline, C-operators
+-Sgic
 
 # ---------------
 # Code generation

install/install.pas

@@ -20,7 +20,9 @@ program install;
 {$ifdef HEAPTRC}
      heaptrc,
 {$endif HEAPTRC}
-     app,dialogs,views,objects,menus,drivers,strings,msgbox,dos,unzip,ziptypes;
+     strings,dos,objects,drivers,
+     commands,app,dialogs,views,menus,msgbox,
+     unzip,ziptypes;
 
   const
      maxpackages=20;
@@ -28,6 +30,12 @@ program install;
 
      cfgfile='install.dat';
 
+{$ifdef linux}
+     DirSep='/';
+{$else}
+     DirSep='\';
+{$endif}
+
   type
      tpackage=record
        name : string[60];
@@ -52,16 +60,48 @@ program install;
        mask     : word;
      end;
 
+     punzipdialog=^tunzipdialog;
+     tunzipdialog=object(tdialog)
+         filetext : pstatictext;
+         constructor Init(var Bounds: TRect; ATitle: TTitleStr);
+         procedure do_unzip(s,topath:string);
+     end;
+
+     penddialog = ^tenddialog;
+     tenddialog = object(tdialog)
+        constructor init;
+     end;
+
+     pinstalldialog = ^tinstalldialog;
+     tinstalldialog = object(tdialog)
+        constructor init;
+     end;
+
+     tapp = object(tapplication)
+         procedure initmenubar;virtual;
+         procedure handleevent(var event : tevent);virtual;
+         procedure do_installdialog;
+         procedure readcfg(const fn:string);
+     end;
+
   var
+     installapp  : tapp;
      startpath   : string;
      successfull : boolean;
      cfg         : cfgrec;
      data        : datarec;
 
+
 {*****************************************************************************
                                   Helpers
 *****************************************************************************}
 
+  procedure errorhalt;
+    begin
+      installapp.done;
+      halt(1);
+    end;
+
   function packagemask(i:longint):longint;
     begin
       packagemask:=1 shl (i-1);
@@ -134,7 +174,7 @@ program install;
       dir : searchrec;
       params : array[0..0] of pointer;
     begin
-       if s[length(s)]='\' then
+       if s[length(s)]=DirSep then
         dec(s[0]);
        s:=lower(s);
        FindFirst(s,$ff,dir);
@@ -177,7 +217,7 @@ program install;
       if doserror=0 then
        begin
          params[0]:=@fn;
-         MessageBox('Config file %s already exists, default config not written',@params,mfinformation+mfokbutton);
+         MessageBox(#3'Default config not written.'#13#3'%s'#13#3'already exists',@params,mfinformation+mfokbutton);
          exit;
        end;
       assign(t,fn);
@@ -187,7 +227,7 @@ program install;
       if ioresult<>0 then
        begin
          params[0]:=@fn;
-         MessageBox('Can''t create %s, default config not written',@params,mfinformation+mfokbutton);
+         MessageBox(#3'Default config not written.'#13#3'%s'#13#3'couldn''t be created',@params,mfinformation+mfokbutton);
          exit;
        end;
       for i:=1to cfg.defcfgs do
@@ -203,129 +243,10 @@ program install;
     end;
 
 
-{*****************************************************************************
-                                   Cfg Read
-*****************************************************************************}
-
-  procedure readcfg(const fn:string);
-    var
-      t    : text;
-      i,j,
-      line : longint;
-      item,
-      s    : string;
-
-{$ifndef FPC}
-      procedure readln(var t:text;var s:string);
-      var
-        c : char;
-        i : longint;
-      begin
-        c:=#0;
-        i:=0;
-        while (not eof(t)) and (c<>#10) do
-         begin
-           read(t,c);
-           if c<>#10 then
-            begin
-              inc(i);
-              s[i]:=c;
-            end;
-         end;
-        if (i>0) and (s[i]=#13) then
-         dec(i);
-        s[0]:=chr(i);
-      end;
-{$endif}
-
-    begin
-      assign(t,fn);
-      {$I-}
-       reset(t);
-      {$I+}
-      if ioresult<>0 then
-       begin
-         writeln('error: ',fn,' not found!');
-         halt(1);
-       end;
-      line:=0;
-      while not eof(t) do
-       begin
-         readln(t,s);
-         inc(line);
-         if (s<>'') and not(s[1] in ['#',';']) then
-          begin
-            i:=pos('=',s);
-            if i>0 then
-             begin
-               item:=upper(Copy(s,1,i-1));
-               delete(s,1,i);
-               if item='VERSION' then
-                cfg.version:=s
-               else
-                if item='TITLE' then
-                 cfg.title:=s
-               else
-                if item='BASEPATH' then
-                 cfg.basepath:=s
-               else
-                if item='PPC386' then
-                 cfg.ppc386:=s
-               else
-                if item='BINSUB' then
-                 cfg.binsub:=s
-               else
-                if item='CFGFILE' then
-                 cfg.defcfgfile:=s
-               else
-                if item='DEFAULTCFG' then
-                 begin
-                   repeat
-                     readln(t,s);
-                     if upper(s)='ENDCFG' then
-                      break;
-                     if cfg.defcfgs<maxdefcfgs then
-                      begin
-                        inc(cfg.defcfgs);
-                        cfg.defcfg[cfg.defcfgs]:=newstr(s);
-                      end;
-                   until false;
-                 end
-               else
-                if item='PACKAGE' then
-                 begin
-                   j:=pos(',',s);
-                   if (j>0) and (cfg.packages<maxpackages) then
-                    begin
-                      inc(cfg.packages);
-                      cfg.package[cfg.packages].zip:=copy(s,1,j-1);
-                      cfg.package[cfg.packages].name:=copy(s,j+1,255);
-                    end;
-                 end
-               else
-                writeln('error in confg, unknown item "',item,'" skipping line ',line);
-             end
-            else
-             writeln('error in confg, skipping line ',line);
-          end;
-       end;
-      close(t);
-    end;
-
-
 {*****************************************************************************
                                TUnZipDialog
 *****************************************************************************}
 
-  type
-     punzipdialog=^tunzipdialog;
-     tunzipdialog=object(tdialog)
-         filetext : pstatictext;
-         constructor Init(var Bounds: TRect; ATitle: TTitleStr);
-         procedure do_unzip(s,topath:string);
-     end;
-
-
   constructor tunzipdialog.Init(var Bounds: TRect; ATitle: TTitleStr);
     var
       r : trect;
@@ -348,40 +269,50 @@ program install;
          begin
             messagebox('File: '+s+' missed for the selected installation. '+
                        'Installation doesn''t becomes complete',nil,mferror+mfokbutton);
-            halt(1);
+            errorhalt;
          end;
-       fn:=startpath+'\'+s+#0;
+       fn:=startpath+DirSep+s+#0;
        dir:=topath+#0;
        wild:='*.*'#0;
        FileUnzipEx(@fn[1],@dir[1],@wild[1]);
        if doserror<>0 then
          begin
             messagebox('Error when extracting. Disk full?',nil,mferror+mfokbutton);
-            halt(1);
+            errorhalt;
          end;
     end;
 
 
 {*****************************************************************************
-                               TInstallDialog
+                               TEndDialog
 *****************************************************************************}
 
-  type
-     pinstalldialog = ^tinstalldialog;
-     tinstalldialog = object(tdialog)
-        constructor init;
-     end;
+  constructor tenddialog.init;
+    var
+      R       : TRect;
+      P       : PStaticText;
+      Control : PButton;
+    begin
+      R.Assign(6, 6, 74, 16);
+      inherited init(r,'Installation Successfull');
 
-  type
-     tapp = object(tapplication)
-         procedure initmenubar;virtual;
-         procedure handleevent(var event : tevent);virtual;
-         procedure do_installdialog;
-     end;
+      R.Assign(2, 2, 64, 5);
+      P:=new(pstatictext,init(r,'Extend your PATH variable with '''+data.basepath+cfg.binsub+''''));
+      insert(P);
+
+      R.Assign(2, 4, 64, 5);
+      P:=new(pstatictext,init(r,'To compile files enter '''+cfg.ppc386+' [file]'''));
+      insert(P);
+
+      R.Assign (29, 7, 39, 9);
+      Control := New (PButton, Init (R,'~O~k', cmOK, bfDefault));
+      Insert (Control);
+    end;
 
-  var
-     installapp : tapp;
 
+{*****************************************************************************
+                               TInstallDialog
+*****************************************************************************}
 
   constructor tinstalldialog.init;
     var
@@ -419,7 +350,7 @@ program install;
         begin
           if file_exists(cfg.package[i].zip,startpath) then
            begin
-             items:=newsitem(cfg.package[i].name+diskspace(startpath+'\'+cfg.package[i].zip),items);
+             items:=newsitem(cfg.package[i].name+diskspace(startpath+DirSep+cfg.package[i].zip),items);
              mask_components:=mask_components or packagemask(i);
            end
           else
@@ -432,9 +363,7 @@ program install;
        if mask_components=0 then
         begin
           messagebox('No components found to install, aborting.',nil,mferror+mfokbutton);
-          { this clears the screen at least PM }
-          installapp.done;
-          halt(1);
+          errorhalt;
         end;
 
        inc(line,3);
@@ -466,6 +395,7 @@ program install;
     var
        p    : pinstalldialog;
        p2   : punzipdialog;
+       p3   : penddialog;
        r    : trect;
        result,
        c    : word;
@@ -475,8 +405,8 @@ program install;
       data.mask:=0;
 
       repeat
+      { select components }
         p:=new(pinstalldialog,init);
-        { default settings }
         c:=executedialog(p,@data);
         if (c=cmok) then
           begin
@@ -497,6 +427,7 @@ program install;
           exit;
       until false;
 
+    { extract }
       r.assign(20,7,60,16);
       p2:=new(punzipdialog,init(r,'Extracting files'));
       desktop^.insert(p2);
@@ -508,10 +439,116 @@ program install;
       desktop^.delete(p2);
       dispose(p2,done);
 
-      writedefcfg(data.basepath+cfg.binsub+'\'+cfg.defcfgfile);
+    { write config }
+      writedefcfg(data.basepath+cfg.binsub+DirSep+cfg.defcfgfile);
 
-      messagebox('Installation successfull',nil,mfinformation+mfokbutton);
-      successfull:=true;
+    { show end message }
+      p3:=new(penddialog,init);
+      executedialog(p3,nil);
+    end;
+
+
+  procedure tapp.readcfg(const fn:string);
+    var
+      t    : text;
+      i,j,
+      line : longint;
+      item,
+      s    : string;
+      params : array[0..0] of pointer;
+
+{$ifndef FPC}
+      procedure readln(var t:text;var s:string);
+      var
+        c : char;
+        i : longint;
+      begin
+        c:=#0;
+        i:=0;
+        while (not eof(t)) and (c<>#10) do
+         begin
+           read(t,c);
+           if c<>#10 then
+            begin
+              inc(i);
+              s[i]:=c;
+            end;
+         end;
+        if (i>0) and (s[i]=#13) then
+         dec(i);
+        s[0]:=chr(i);
+      end;
+{$endif}
+
+    begin
+      assign(t,fn);
+      {$I-}
+       reset(t);
+      {$I+}
+      if ioresult<>0 then
+       begin
+         params[0]:=@fn;
+         messagebox('File %s not found!',@params,mferror+mfokbutton);
+         errorhalt;
+       end;
+      line:=0;
+      while not eof(t) do
+       begin
+         readln(t,s);
+         inc(line);
+         if (s<>'') and not(s[1] in ['#',';']) then
+          begin
+            i:=pos('=',s);
+            if i>0 then
+             begin
+               item:=upper(Copy(s,1,i-1));
+               system.delete(s,1,i);
+               if item='VERSION' then
+                cfg.version:=s
+               else
+                if item='TITLE' then
+                 cfg.title:=s
+               else
+                if item='BASEPATH' then
+                 cfg.basepath:=s
+               else
+                if item='PPC386' then
+                 cfg.ppc386:=s
+               else
+                if item='BINSUB' then
+                 cfg.binsub:=s
+               else
+                if item='CFGFILE' then
+                 cfg.defcfgfile:=s
+               else
+                if item='DEFAULTCFG' then
+                 begin
+                   repeat
+                     readln(t,s);
+                     if upper(s)='ENDCFG' then
+                      break;
+                     if cfg.defcfgs<maxdefcfgs then
+                      begin
+                        inc(cfg.defcfgs);
+                        cfg.defcfg[cfg.defcfgs]:=newstr(s);
+                      end;
+                   until false;
+                 end
+               else
+                if item='PACKAGE' then
+                 begin
+                   j:=pos(',',s);
+                   if (j>0) and (cfg.packages<maxpackages) then
+                    begin
+                      inc(cfg.packages);
+                      cfg.package[cfg.packages].zip:=copy(s,1,j-1);
+                      cfg.package[cfg.packages].name:=copy(s,j+1,255);
+                    end;
+                 end;
+             end;
+          end;
+       end;
+      close(t);
     end;
 
 
@@ -553,23 +590,18 @@ begin
    fillchar(cfg, SizeOf(cfg), 0);
    fillchar(data, SizeOf(data), 0);
 
-   readcfg(cfgfile);
-
    installapp.init;
+   installapp.readcfg(cfgfile);
    installapp.do_installdialog;
    installapp.done;
-
-   if successfull then
-     begin
-        writeln('Extend your PATH variable with ''',data.basepath+cfg.binsub+'''');
-        writeln;
-        writeln('To compile files enter ''',cfg.ppc386,' [file]''');
-        writeln;
-     end;
 end.
 {
   $Log$
-  Revision 1.11  1998-11-01 20:32:25  peter
+  Revision 1.12  1998-12-16 00:25:34  peter
+    * updated for 0.99.10
+    * new end dialogbox
+
+  Revision 1.11  1998/11/01 20:32:25  peter
     * packed record
 
   Revision 1.10  1998/10/25 23:38:35  peter

install/install.w32

@@ -4,7 +4,7 @@
 # Win32 Install file
 #
 title=Free Pascal Compiler for Win32
-version=0.99.8
+version=0.99.10
 
 basepath=c:\pp
 binsub=\bin\win32
@@ -16,14 +16,14 @@ package=gdbw32.zip,GNU ~D~ebugger for Win32
 package=utilw32.zip,GNU ~U~tilities (required to recompile run time library)
 package=demo.zip,D~e~mos
 package=docs-htm.zip,Documentation (~H~TML)
-package=rl0998s.zip,~R~un time library sources
-package=pp0998s.zip,~C~ompiler sources
+package=rl09910s.zip,~R~un time library sources
+package=pp09910s.zip,~C~ompiler sources
 package=doc110s.zip,Documentation sources (La~T~eX)
 
 cfgfile=ppc386.cfg
 defaultcfg=
 #
-# Example ppc386.cfg for Free Pascal Compiler Version 0.99.8
+# Example ppc386.cfg for Free Pascal Compiler Version 0.99.10
 #
 
 # ----------------------
@@ -81,10 +81,9 @@ defaultcfg=
 # -So   tries to be TP/BP 7.0 compatible
 # -Ss   constructor name must be init (destructor must be done)
 # -St   allows static keyword in objects
-# -Sv   allow CVAR variable directive
 
-# Allow goto, inline, C-operators, CVar directive
--Sgicv
+# Allow goto, inline, C-operators
+-Sgic
 
 # ---------------
 # Code generation