home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBCS / DEMOS / UGREP / gsr.pas next >
Encoding:
Pascal/Delphi Source File  |  1993-04-02  |  11.5 KB  |  345 lines
  1. (*
  2.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  3.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  4.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  5.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  6.     ▓▓▓▓▓▓▓▓·──                                              ──·▓▓▓▓▓▓▓▓▓▓▓
  7.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  8.     ▓▓▓▓▓▓▓▓   GSR was Conceived, Designed and Written          ░░▓▓▓▓▓▓▓▓▓
  9.     ▓▓▓▓▓▓▓▓   by Floor A.C. Naaijkens for                      ░░▓▓▓▓▓▓▓▓▓
  10.     ▓▓▓▓▓▓▓▓   UltiHouse Software / The ECO Group.              ░░▓▓▓▓▓▓▓▓▓
  11.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  12.     ▓▓▓▓▓▓▓▓   (C) MCMXCII by EUROCON PANATIONAL CORPORATION.   ░░▓▓▓▓▓▓▓▓▓
  13.     ▓▓▓▓▓▓▓▓   All Rights Reserved for The ECO Group.           ░░▓▓▓▓▓▓▓▓▓
  14.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  15.     ▓▓▓▓▓▓▓▓   Global Search and Replace uses a library file    ░░▓▓▓▓▓▓▓▓▓
  16.     ▓▓▓▓▓▓▓▓   to search for certain words/patterns and         ░░▓▓▓▓▓▓▓▓▓
  17.     ▓▓▓▓▓▓▓▓   places them with a translation. Multiple files.  ░░▓▓▓▓▓▓▓▓▓
  18.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  19.     ▓▓▓▓▓▓▓▓·──                                              ──·░░▓▓▓▓▓▓▓▓▓
  20.     ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓
  21.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  22.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  23.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  24. *)
  25. {$A-,B-,D-,E-,F+,I-,L-,N-,O-,R-,S-,V-}
  26. {$M 65520, 0, 655360}
  27.  
  28. uses
  29.   dos, crt, eco_lib
  30.  
  31.  ;
  32.  
  33.  
  34.  
  35. type
  36.   str80 = string[80];
  37.   heap = array[1..2000] of ^str80;
  38.   buftype = array[1..32768] of char;
  39.  
  40.  
  41. const
  42.   reppos   : byte = 41;
  43.   numfiles : word =  0;
  44.   fctotal  : word =  0;
  45.  
  46. var
  47.   allfiles             : array[1..2048] of ^searchrec;
  48.   nextfile             :   searchrec;
  49.   inbuf, outbuf        :    ^buftype;
  50.   first, makebak,
  51.   questionmode, show,
  52.   debugmode,initques,
  53.   sensi, quit          :     boolean;
  54.   b                    :        word;
  55.   reps, k, totreps,
  56.   libentries, fc,
  57.   i, j, match,
  58.   error, nrs           :        word;
  59.   numbytes             :     longint;
  60.   tmps, st,
  61.   librar,
  62.   out_filename,
  63.   in_filename          :      string;
  64.  
  65.   check, replace       :        heap;
  66.  
  67.   in_file, out_file,
  68.   check_file           :        text;
  69.  
  70.  
  71.  
  72.   function __trail(s: string): string;
  73.   var i : byte;
  74.   begin
  75.     i := length(s); while s[i] = ' ' do dec(i);
  76.     __trail := copy(s, 1, i);
  77.   end;
  78.  
  79.  
  80.  
  81.   function __case(s: string): string;
  82.   begin
  83.     if not sensi then __case := __up(s) else __case := s;
  84.   end;
  85.  
  86.  
  87.  
  88.   procedure microhelp;
  89.   begin
  90.     writeln('GSR - Global Search & Replace Utility -- Version 1.0');
  91.     writeln('(C) MCMXCII by UltiHouse Software / The ECO Group.');
  92.     writeln('Part of the UltiGREP package: GSR, USR, QF, UGREP.');
  93.   end;
  94.  
  95.  
  96.  
  97.   procedure help;
  98.   begin
  99.     writeln;
  100.     writeln('Usage: GSR INTEXT {librar | /r} {options}');
  101.     writeln;
  102.     writeln('  Search for strings in librar (default: gsr_std.lib) and replaces');
  103.     writeln('  each occurence with replacement string. librar layout: each string');
  104.     writeln('  contains in pos(1) the searchstring, and in pos(41) the replacement.');
  105.     writeln('  No more than 2000 entities may be specified.');
  106.     writeln;
  107.     writeln('Options:');
  108.     writeln('  /b       create backupfiles.');
  109.     writeln('  /c       search casesensitive.');
  110.     writeln('  /d       debugmode: shows info during scan.');
  111.     writeln('  /p xx    position replacmentstring on line (up to 80, line 160).');
  112.     writeln('  /q       questionmode after each find, whether you want replacement.');
  113.     writeln('  /r       special option (note place) to have user specify s&r');
  114.     writeln('  /s       show strings on screen. (one line)');
  115.     writeln;
  116.     writeln('During operation, <Esc> will bring you back to the OS.');
  117.     writeln; halt;
  118.   end;
  119.  
  120.  
  121.  
  122.   procedure scroll;
  123.   var x, y: byte;
  124.   begin
  125.     y := wherey; x := wherex; gotoxy(1, 25); clreol; writeln; gotoxy(x, y)
  126.   end;
  127.  
  128.  
  129.  
  130.   procedure curstr;
  131.   begin
  132.     textcolor(7); textbackground(0);
  133.     gotoxy(1, wherey); write(copy(st, 1, 79)); clreol;
  134.   end;
  135.  
  136.  
  137.  
  138.   procedure userlibrar;
  139.   var
  140.     eoinput      : boolean;
  141.     st, st1, st2 :  string;
  142.     i            :    byte;
  143.     c            :    char;
  144.     libtext      :    text;
  145.  
  146.   begin
  147.     eoinput := false; libentries := 0;
  148.     writeln('Enter librar:');
  149.     repeat
  150.       write('Search: '); readln(st1);
  151.       if st1 = '' then eoinput := true else begin
  152.         write('Replace: '); readln(st2);
  153.         inc(libentries); new(check[libentries]); new(replace[libentries]);
  154.         check[libentries]^ := __trail(st1); 
  155.         replace[libentries]^ := __trail(st2);
  156.       end;
  157.     until eoinput;
  158.     write('Save this into librar?  (Y/N/Q) ');
  159.     repeat c := readkey until upcase(c) in ['Y', 'N', 'Q'];
  160.     writeln(upcase(c));
  161.     if upcase(c) = 'Y' then begin
  162.       write('Name (No .LIB needed) ? ');
  163.       readln(st);
  164.       if pos('.', __extractname(st)) = 0 then st := fexpand(st + '.LIB');
  165.       writeln('Writing ', st);
  166.       assign(libtext, st); rewrite(libtext);
  167.       for i := 1 to libentries do writeln(libtext, 
  168.         __juststr(check[i]^, ' ', 40, _left_just_str) +
  169.         __juststr(replace[i]^, ' ', 40, _left_just_str)
  170.       );
  171.       close(libtext);
  172.     end else if upcase(c) = 'Q' then halt;
  173.   end;
  174.  
  175.  
  176.  
  177.   function yesanswer: boolean;
  178.   var
  179.     c    : char;
  180.     oldy : byte;
  181.  
  182.   begin
  183.     oldy := wherey;
  184.     if (oldy > 24) and first then begin scroll; gotoxy(1, 24) end;
  185.     curstr; gotoxy(j, wherey); textcolor(0); textbackground(7);
  186.     write(copy(check[i]^, 1, 80-j)); gotoxy(1, 25);
  187.     write('File: ', __extractname(in_filename), '  Reps: ', reps,
  188.       '  Pos: ', fc, ':', j,
  189.       '  Rep: "', copy(replace[i]^, 1, 14), '"  Replace Y/G/N/Q '
  190.     );
  191.     clreol; textcolor(7); textbackground(0); __flushkey;
  192.     repeat c := readkey until upcase(c) in ['Y', 'G' ,'N', 'Q'];
  193.     yesanswer := upcase(c) in ['Y', 'G']; write(upcase(c));
  194.     if upcase(c) = 'G' then questionmode := false;
  195.     if upcase(c) = 'Q' then quit := true;
  196.     first := false;
  197.     if (oldy >= 24) then gotoxy(1, 24) else gotoxy(1, oldy);
  198.   end;
  199.  
  200.  
  201.   procedure chkesc;
  202.   begin
  203.     if keypressed and (readkey = #27) then begin
  204.       __erasefil(out_filename, error); halt
  205.     end;
  206.   end;
  207.  
  208.  
  209.  
  210.  
  211. {main}begin
  212.   if not __isconfil(__handlfil(output)) then __stdio;
  213.   textcolor(yellow); microhelp; textcolor(lightgray);
  214.   if __inparams('?', b) or __inparams('/?', b) or __inparams('-?', b) then help;
  215.  
  216.   if __inparams('/p', b) then begin
  217.     reppos := __val(paramstr(b));
  218.     writeln('Replacement position set to: ', reppos);
  219.   end;
  220.  
  221.   new(inbuf); new(outbuf);
  222.   show := false;
  223.   sensi := __inparams('/c', b);
  224.   questionmode := __inparams('/q', b);
  225.   initques := questionmode;
  226.   show := questionmode or __inparams('/s', b);
  227.   debugmode := __inparams('/d', b);
  228.   makebak := __inparams('/b', b);
  229.  
  230.  
  231.   if paramcount > 1 then st := paramstr(2);                    { read librar }
  232.   if st = '/r' then userlibrar else begin
  233.     if (st[1] <> '/') and (paramcount > 1) then librar := __up(st) else
  234.       librar := __backapp(__extractpath(paramstr(0))) + 'GSR_STD.LIB';
  235.     if pos('.', librar) = 0 then librar := librar + '.LIB';
  236.     write('Searching librar: ', librar);
  237.     if not __existfil(librar) then begin
  238.       writeln(' -- Error - librar not found!'); halt(1)
  239.     end;
  240.     assign(check_file, librar); reset(check_file); 
  241.     settextbuf(check_file, inbuf^);
  242.     libentries := 0;
  243.     repeat
  244.       readln(check_file, tmps);
  245.       if __nw(tmps) <> '' then begin
  246.         inc(libentries); new(check[libentries]); new(replace[libentries]);
  247.         check[libentries]^ := __trail(copy(tmps, 1, reppos-1));
  248.         replace[libentries]^ := __trail(copy(tmps, reppos, reppos-1));
  249.       end;
  250.     until eof(check_file); close(check_file);
  251.   end;
  252.   writeln('... read.');
  253.  
  254.   if paramcount > 0 then tmps := paramstr(1) else tmps := '*.*';
  255.   if tmps[1] <> '/' then in_filename := fexpand(tmps) else
  256.     in_filename := fexpand('*.PAS');
  257.   match := 0;
  258.   if pos('.', in_filename) = 0 then in_filename := in_filename + '.PAS';
  259.   findfirst(in_filename, anyfile, nextfile); numbytes := 0;
  260.   while doserror = 0 do begin           { not using "notnone" or "only" attrs }
  261.     if (
  262.       __attrfilter(nextfile.attr, archive + readonly + hidden) and
  263.       __existfil(nextfile.name)
  264.     ) then begin
  265.       inc(numfiles); new(allfiles[numfiles]);
  266.       allfiles[numfiles]^ := nextfile; inc(numbytes, nextfile.size);
  267.     end;
  268.     findnext(nextfile);
  269.   end; { allfiles }
  270.  
  271.   if numfiles = 0 then begin
  272.     writeln('Error - No inputfile(s) found.'); halt
  273.   end;
  274.   writeln(numfiles, ' files found, ', __pntstr(numbytes), ' bytes.');
  275.   totreps := 0;
  276.   for k := 1 to numfiles do begin
  277.     reps := 0;
  278.     out_filename := fexpand('');
  279.     __uniquefil(out_filename, out_file, error);
  280.     if sensi then writeln('Case sensitive mode');
  281.     if debugmode then writeln('debugmode mode.');
  282.     if questionmode then clrscr;
  283.   
  284.     assign(in_file, allfiles[k]^.name); reset(in_file);
  285.     assign(out_file, out_filename); rewrite(out_file);
  286.     gotoxy(6, wherey);
  287.     if not questionmode then write(
  288.       fexpand(__up(allfiles[k]^.name)) + '  '
  289.     );
  290.     textcolor(lightgray);
  291.     settextbuf(in_file, inbuf); settextbuf(out_file, outbuf^);
  292.     fc := 0; quit := false;
  293.   
  294.     while not(eof(in_file) or quit) do begin
  295.       readln(in_file, st);
  296.       inc(fc); if fc mod 7 = 0 then begin gotoxy(1, wherey); write(fc) end;
  297.       chkesc;
  298.  
  299.       first := true;
  300.   
  301.       for i := 1 to libentries do begin               { recurse though string }
  302.         if not quit then begin
  303.           j := 1;
  304.           repeat
  305.             if debugmode then writeln(st);
  306.             b := pos(__case(check[i]^), __case(copy(st, j, length(st)-j+1)));
  307.             if b > 0 then j := b + j - 1 else j := 0;
  308.             if debugmode then begin
  309.               if j < 78 then gotoxy(j, wherey) else gotoxy(77, wherey);
  310.               writeln('Lib: ', i, '  Line: ', fc, '  Linepos = ', j);
  311.             end;
  312.   
  313.             if (j > 0) then if not(questionmode and not yesanswer) then begin
  314.               delete(st, j, length(check[i]^)); insert(replace[i]^, st, j);
  315.               inc(j, length(replace[i]^)); inc(reps);
  316.             end else inc(j, length(check[i]^));
  317.             chkesc;
  318.           until (j = 0) or (j >= length(st)) or quit;
  319.         end;
  320.       end;
  321.       if show then curstr;
  322.       if questionmode then writeln;
  323.      { if (wherey < 25) or (not(questionmode) and initques) then writeln;}
  324.       writeln(out_file, st);
  325.     end;
  326.     gotoxy(1, wherey); 
  327.     write(fc); gotoxy(50, wherey); inc(totreps, reps); write('R:', reps);
  328.     close(in_file); close(out_file);
  329.     if not quit then begin
  330.       if makebak then __renamfil(
  331.         allfiles[k]^.name, fexpand(__bak(allfiles[k]^.name)), error
  332.       ) else erase(in_file);
  333.       rename(out_file, allfiles[k]^.name);
  334.     end else __erasefil(out_filename, error);
  335.     writeln;
  336.     inc(fctotal, fc);
  337.   end; { for k }
  338.  
  339.   gotoxy(1, wherey);
  340.   write(fctotal, ' lines, ', libentries, ' librar entries and ',
  341.     totreps, ' replacements in ', copy(getlaptime(0), 1, 8)
  342.   );
  343.   clreol; writeln;
  344. {happy}end.
  345.