home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol270 / update.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1986-05-22  |  2.4 KB  |  90 lines
  1. { update.pas
  2.     update library  by K.Nakazato
  3.       Ver. 1.0   December 10, 1984 }
  4.  
  5. const
  6.   name_length =16;
  7.   max_name    =128;
  8.   line_length =128;
  9.   max_buf     =$3FFF;
  10.   default_name='LIB.INC';
  11. type
  12.   symbol=(nosym,namesym,externalsym,scansym);
  13.   linetype   =string[line_length];
  14.   stringtype =string[name_length];
  15.   stringarray
  16.     =record
  17.        number:integer;
  18.        name  :array [1..max_name] of stringtype
  19.      end;
  20. var
  21.   infile,outfile:text;
  22.   bufindex      :array [0..1] of integer;
  23.   buffer        :array [1..max_buf] of char;
  24.   arg,lib_,add_ :stringarray;
  25.   error         :boolean;
  26.   lib_name,add_name,outfile_name:stringtype;
  27.  
  28. {$I LIB.INC}
  29. {#scan lib.lib}
  30. {#external getarg,exist,set_buffer,set_string,write_lib}
  31.  
  32. procedure init;
  33. var j:integer;
  34. begin
  35.   getarg(arg);
  36.   if arg.number<1 then
  37.     begin
  38.       writeln('Update library');
  39.       writeln('usage: >update library_file_name [include_file_name]');
  40.       writeln('  When "include_file_name" is absent, "LIB.INC" is assumed.');
  41.       halt
  42.     end
  43.   else lib_name:=arg.name[1];
  44.   outfile_name:=lib_name;
  45.   j:=pos('.',outfile_name);
  46.   if j>0 then outfile_name[0]:=chr(j-1);
  47.   if arg.number<2 then add_name:=default_name
  48.                   else add_name:=arg.name[2]
  49. end;
  50.  
  51. var a:char; i:integer; flag:boolean;
  52. begin
  53.   init; error:=false;
  54.   assign(infile,lib_name); {$I-}; reset(infile); {$I+};
  55.   flag:=(ioresult=0); close(infile);
  56.   if flag then
  57.     begin
  58.       bufindex[0]:=1; set_buffer(lib_name,bufindex[0]);
  59.       set_string(namesym,lib_)
  60.     end
  61.   else lib_.number:=0;
  62.   bufindex[0]:=1; set_buffer(add_name,bufindex[0]);
  63.   set_string(namesym,add_);
  64.   assign(outfile,outfile_name+'.$$$'); rewrite(outfile);
  65.   for i:=1 to lib_.number do
  66.     begin
  67.       a:='N';
  68.       if exist(add_,lib_.name[i]) then
  69.         repeat
  70.           write(lib_.name[i]:17,' update [y/n] ? ');
  71.           read(trm,a); a:=upcase(a); writeln
  72.         until a in ['Y','N'];
  73.       if      a='Y' then write_lib(add_name,lib_.name[i])
  74.       else if a='N' then write_lib(lib_name,lib_.name[i])
  75.     end;
  76.   for i:=1 to add_.number do
  77.     if not exist(lib_,add_.name[i]) then
  78.       repeat
  79.         write(add_.name[i]:17,'    add [y/n] ? ');
  80.         read(trm,a); a:=upcase(a); writeln;
  81.         if a='Y' then write_lib(add_name,add_.name[i])
  82.       until a in ['Y','N'];
  83.   close(outfile);
  84.   if flag then
  85.     begin
  86.       assign(outfile,lib_name); rename(outfile,outfile_name+'.bak')
  87.     end;
  88.   assign(outfile,outfile_name+'.$$$'); rename(outfile,lib_name)
  89. end.
  90.