File r38/help/sed.red from the latest check-in

%
% This program makes some systematic edits, and some that are clearly
% ad hoc. The syematic changes include expanding tabs and cleaning up
% trailing whitespace, plus processing of some escapes that "info"
% format uses. The ad hoc ones appear to relate to "words" that have
% embedded apostrophes.
%
% It replaces a sequence of Unix-specific commands, which included use
% of expand to dispose of tabs and several uses of sed to perform the
% other transformations.
% It transforms from package.x to package.y, where package is set to a
% particular string.
% It will also be MUCH slower than direct use of Unix utilities, in part
% because it has been coded here with simplicity, portability and
% clarity as objectives above speed. After all the help file is not
% re-created by end-users and not altered very often anyway.
%
%                                       A C Norman.        December 1995

symbolic;
on comp;

fluid '(edits n_edits);

global '(tab!*);

edits := for each p in '(
   ("Euler's"            . "Euler")
   ("EULER'S"            . "EULER")
   ("Euler constant can" . "Euler's constant can")
   ("Catalan's"          . "Catalan")
   ("CATALAN'S"          . "CATALAN")
   ("Khinchin's"         . "Khinchin")
   ("KHINCHIN'S"         . "KHINCHIN")
   ("Khinchin book"      . "Khinchin's book")
   ("Jacobi's"           . "Jacobi")
   ("@$"                 . "$")
   ("@key"               . "(Key)")
   ("@%"                 . "%")
   ("@_"                 . "_")
         ) collect (explode2 car p . explode2 cdr p);

symbolic procedure matches(x, p);
   if null p then list x
   else if null x then nil
   else if car x eq car p then matches(cdr x, cdr p)
   else nil;

symbolic procedure make_edits();
  begin
    scalar fi, fo, c, line, n, p, w, t0, n_edits,
           !*echo, !*raise, !*lower;
    t0 := time();
    fi := open(concat(package,".x"), 'input);
    if null fi then error(0, "Input file not available");
    fo := open(concat(package,".y"), 'output);
    if null fo then error(0, "Output file not available");
    fi := rds fi;
    fo := wrs fo;
    linelength 1000; % Output must never wrap.
    n_edits := 0;
    c := !$eol!$;
    while not (c = !$eof!$) do <<
       line := nil;
       n := 0;
% While reading a line in I will process tabs, counting a tab as at
% least one blank and then enough to pad out to the next multiple of 8.
       while not ((c := readch()) = !$eol!$ or c = !$eof!$) do <<
          if c = tab!* then <<
             repeat << line := '!  . line;
                       n := n + 1 >> until zerop remainder(n, 8) >>
          else << line := c . line; n := n + 1 >> >>;
% Next I act on 's/  *$//g', which removes all trailing blanks.
       while eqcar(line,'!  ) do line := cdr line;
       line := reversip line;
       while line do <<
          for each p in edits do
             if (w := matches(line, car p)) then <<
                 n_edits := n_edits + 1;
                 line := append(cdr p, car w) >>;
          prin2 car line;
          line := cdr line >>;
       terpri() >>;
    fi := rds fi;
    fo := wrs fo;
    close fi;
    close fo;
    prin2 n_edits; prin2t " edits performed";
    return (time() - t0)/1000.0
  end;

make_edits();

end;