{$T-}
program LISTER;
type EXTENSION = array [0..4] of CHAR;
var CH:CHAR;
const EOLS = EXTENSION('.','O','L','S',' ');
      ELST = EXTENSION('.','L','S','T',' ');
const NL=CHR(10); CR=CHR(13); FF=CHR(12);
var OLS,LST:TEXT;
var LINE:array [0..132] of CHAR; INDEX:INTEGER;
    STATUS:BOOLEAN;
  
  
procedure OPEN_FILES:BOOLEAN;
var FILENAME:array [0..24] of CHAR;
    IDX,COUNT,INDEX:INTEGER;
begin
  WRITE(OUT,NL,'Enter file descriptor without extension:'); BREAK(OUT);
  COUNT:=0; GET(INP);
  while (COUNT<20) & (INP@ # NL) do begin
    FILENAME[COUNT]:=INP@; GET(INP); COUNT:=SUCC(COUNT) end;
  INDEX:=0;
  while INDEX<5 do begin
    FILENAME[COUNT+INDEX]:=EOLS[INDEX]; INDEX:=SUCC(INDEX) end;
  RESET(OLS,FILENAME);
  if ~EOF(OLS) then begin
    INDEX:=0;
    while INDEX<5 do begin
      FILENAME[COUNT+INDEX]:=ELST[INDEX]; INDEX:=SUCC(INDEX) end;
    REWRITE(LST,FILENAME);
    WRITE(OUT,NL,FILENAME:COUNT,' being processed.',NL);
    WRITE(LST,NL,CR,'Output for file ',FILENAME:COUNT,NL,CR);
    BREAK(OUT);
    OPEN_FILES:=TRUE
    end
  else
    OPEN_FILES:=FALSE
end;
  
  
function GETCHAR:CHAR;
begin GETCHAR:=OLS@; GET(OLS) end;
  
  
begin
  STATUS:=OPEN_FILES;
  if STATUS then begin
    while ~EOF(OLS) do begin
      repeat until GETCHAR=';';
      INDEX:=1; LINE[0]:=';';
      CH:=GETCHAR;
      while CH#NL do begin
        LINE[INDEX]:=CH; INDEX:=SUCC(INDEX);
	CH:=GETCHAR
	end;
      INDEX:=PRED(INDEX);
      WRITE(OUT,NL,LINE:INDEX,'  Do you want to list this procedure?');
      BREAK(OUT);
      READ(INP,CH);
      if (CH='Y') ! (CH='y') then begin
	WRITE(LST,FF,NL,LINE:INDEX,NL);
        CH:=GETCHAR;
        while ~EOF(OLS) & (CH#FF) do begin WRITE(LST,CH); CH:=GETCHAR end
        end
      else begin
	CH:=GETCHAR;
	while ~EOF(OLS) & (CH#FF) do CH:=GETCHAR
        end
    end;
    WRITE(OUT,NL,'Processing complete..')
    end
  else
    WRITE(OUT,NL,'File not found...   Try again...');
  BREAK(OUT)
end.