program pfbnames;

uses Dos;

var DirInfo: SearchRec;

function getFontName (fn: string): string;
const separators = [' ', ^I, ^M, ^J];
var f: file of char;
	{ 'text' would sometimes interpret one of the first 6 binary 
	  (block header) bytes as EOF . On the other hand, 'file of char' 
	  is slow (stupid Turbo, probably not buffering file input other 
	  than 'text' (Does Turbo-7 remedy this?). Maybe 'file' with 
	  block operations should be used. }
    lasttoken: string;
    lastch: char;

    procedure getchar;
    begin
         if eof (f) then lastch := chr (0)
                    else read (f, lastch)
    end;

    procedure gettoken;
    begin
	while lastch in separators do getchar;
	if lastch = '/' then begin
		lasttoken := '/';
		getchar;
	end else lasttoken := '';
	while not eof (f) and not (lastch in separators + ['/']) do begin
		lasttoken := lasttoken + lastch;
		getchar;
	end;
    end;
begin
     assign (f, fn);
     reset (f);
     lastch := ' ';
     lasttoken := '';
     while not eof (f) and (lasttoken <> '/FontName')
	do gettoken;
     gettoken;
     getFontName := lasttoken;
     close (f)
end;

begin
  if paramcount > 0 then writeln (getFontName (paramstr (1)))
  else begin
     FindFirst ('*.pfb', $00, DirInfo);
     while DosError = 0 do begin
           writeln (DirInfo.Name, ':', ' ': 13 - length (DirInfo.Name),
                    getFontName (DirInfo.Name));
           FindNext (DirInfo)
     end
  end
end.