// PAS2HTML.PAS
// Convertor PAS to HTML
// Programmed by Ondrej Jombík
// Condy software inc.
// Updates:
//         17.11.1999
//         11.12.1999
//         19.12.1999 (unit StringsUtils)

unit Pas2HtmlUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    OpenButton: TButton;
    GenerateButton: TButton;
    AuthorEdit: TEdit;
    AuthorLabel: TLabel;
    OpenDialog: TOpenDialog;
    TextColorEdit: TEdit;
    TextColorLabel: TLabel;
    BckColorEdit: TEdit;
    BckColorLabel: TLabel;
    StrColorEdit: TEdit;
    StrColorLabel: TLabel;
    procedure OpenButtonClick(Sender: TObject);
    procedure GenerateButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    Gz:char;
    Gs:string;
    Lexem:(eEnd,eReserved,eString,eComment,eIdent,eVoid);
    FIn,FOut: TextFile;
    FInStr,FOutStr: string;
    procedure znak;
    procedure scan;
    procedure nahrad(const s:char;const news:string);
    function CheckReserved(const s:string):boolean;
    procedure WriteHeader;
    procedure WriteEnd;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

const
  EOL=#13#10;
  cProgramName='Pas2Html Convertor';
  cReserved=72;
  cResStr:array[0..cReserved-1] of string=
('and','array','as','asm','begin','case','class','const','constructor','destructor',
'dispinterface','div','do','downto','else','end','except','exports','file','finalization',
'finally','for','function','goto','if','implementation','in','inherited','initialization','inline',
'interface','is','label','library','mod','nil','not','object','of','or',
'out','packed','procedure','program','property','raise','record','repeat','resourcestring','set',
'shl','shr','string','then','threadvar','to','try','type','unit','until',
'uses','var','while','with','xor','private','protected','public','published','automated',
'at','on');

implementation

uses StringsUtils;

{$R *.DFM}
procedure TForm1.znak;
begin
  if eof(fIn) then Gz:=#0
  else
    if eoln(fIn) then begin
      readln(fIn); Gz:=#1
    end
    else read(fIn,Gz);
end;

procedure TForm1.scan;
var
  ok:boolean;
begin
  Gs:='';
  repeat
    case Gz of
      #0: begin
        Lexem:=eEnd; ok:=true;
      end;
      '/'begin
        Gs:=Gs+Gz;
        znak;
        if Gz='/' then begin
          repeat
            Gs:=Gs+Gz;
            znak;
          until Gz in [#0,#1];
          Lexem:=eComment
        end
        else Lexem:=eVoid;
        ok:=true;
      end;
      '{'begin
        repeat
          Gs:=Gs+Gz;
          znak
        until Gz in ['}',#0];
        if Gz<>#0 then begin Gs:=Gs+Gz; znak; end;
        Lexem:=eComment;
        ok:=true;
      end;
      ''''begin
        repeat
          Gs:=Gs+Gz;
          znak;
        until Gz in ['''',#0];
        if Gz<>#0 then begin Gs:=Gs+Gz; znak; end;
        Lexem:=eString;
        ok:=true;
      end;
      'A'..'Z','a'..'z','_'begin
        while Gz in ['A'..'Z','a'..'z','_','0'..'9'do begin
          Gs:=Gs+Gz;
          znak;
        end;
        if CheckReserved(Gs) then Lexem:=eReserved
        else Lexem:=eIdent;
        ok:=true;
      end;
      else
        Lexem:=eVoid;
        Gs:=Gz;
        ok:=true;
        znak;
    end;
  until ok;
end;

procedure TForm1.nahrad(const s:char;const news:string);
begin
  while pos(s,Gs)<>0 do begin
    insert(news,Gs,pos(s,Gs));
    delete(Gs,pos(s,Gs),Length(s));
  end;
end;

function TForm1.CheckReserved(const s:string):boolean;
var
  k:integer;
begin
  Result:=false;
  for k:=0 to cReserved-1 do if s=cResStr[k] then Result:=true;
end;

procedure TForm1.WriteHeader;
begin
   writeln(FOut,'<html>'+EOL+'<head>');
   writeln(FOut,'<meta http-equiv="Content-Type" content="text/html; charset=windows-1250">');
   writeln(FOut,'<meta name="GENERATOR" content="Pas2Html Convertor by Ondrej Jombík, (c) 1999 Copyright Condy software inc.">');
   writeln(FOut,'<meta name="Author" content="'+AuthorEdit.Text+'">');
   writeln(FOut,'<meta name="Description" content="Generated Pascal source file">');
   writeln(FOut,'<title>'+GetFilename(FOutStr)+'</title>');
   writeln(FOut,'</head>'+EOL+'<body text="'+TextColorEdit.Text+
     '" bgcolor="'+BckColorEdit.Text+'">'+EOL+'<tt>');
end;
procedure TForm1.WriteEnd;
begin
  writeln(FOut,EOL+'</tt>'+EOL+'</body>'+EOL+'</html>');
end;
procedure TForm1.OpenButtonClick(Sender: TObject);
begin
  GetDir(0,FInStr);
  OpenDialog.InitialDir:=FInStr;
  if not OpenDialog.Execute then exit;

  FInStr:=OpenDialog.FileName;
  FOutStr:=ChangeExtension(FInStr,'html');

  GenerateButton.Enabled:=True;
  GenerateButton.Caption:='Generate '+GetFilename(FOutStr);
  Caption:=cProgramName+' ['+GetFilename(FInStr)+']';
end;

procedure TForm1.GenerateButtonClick(Sender: TObject);
begin
  AssignFile(FIn,OpenDialog.Filename);
  Reset(FIn);
  AssignFile(FOut,FOutStr);
  Rewrite(FOut);
  WriteHeader;
  znak; scan;
  while Lexem<>eEnd do begin
    Gs:=ReplaceString(Gs,'&','&amp;');
    nahrad(' ','&nbsp;');
    nahrad('<','&lt;');
    nahrad('>','&gt;');
    nahrad('"','&quot;');
    nahrad(#1,'<br>');
    case Lexem of
      eEnd: break;
      eReserved: write(FOut,'<b>'+Gs+'</b>');
      eString: write(FOut,'<font color="'+StrColorEdit.Text +'">'+Gs+'</font>');
      eComment: write(FOut,'<i>'+Gs+'</i>');
      eVoid,eIdent: write(FOut,Gs);
    end;
    scan;
  end;

  WriteEnd;
  CloseFile(FOut);
  CloseFile(FIn);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption:=cProgramName;
  GenerateButton.enabled:=false;
end;

end.