unit UPasHtm; { v. 0.10 }
{ Under GNU License }
{ this unit converts a pascal }
{ page in a web page }
{ JOAO PAULO SCHWARZ SCHULER }
{ http://www.schulers.com }
{ Turbo Pascal Source }
{ Free Pascal Source for DOS }
{ Free Pascal Source for Linux }
{ Delphi32 Source Code }
(*
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
*)
interface
uses reser;
Procedure ConvertPasToHtm(InputFileName,OutPutFileName:String);
{ do it ! }
procedure SetColors(Com,Str,Dig,Back:string);
{ Set the colors used by ConvertPasToHtm procedure}
implementation
var clString,clCom,clNumber,clBack:string;
function IsAlpha(C:char):boolean;
{devolve true se eh caracter}
begin
IsAlpha:=( (C>='A') and (C<='Z') ) or ( (C>='a') and (C<='z') ) ;
end;
function IsDigit(C:char):boolean;
{devolve true se eh digito}
begin
IsDigit:=( (C>='0') and (C<='9') );
end;
function IsHexDigit(C:char):boolean;
{devolve true se eh digito}
begin
IsHexDigit:=(IsDigit(C)) or (pos(UpCase(C),'ABCDEF')<>0);
end;
function IsDelim(C:char):boolean;
{devolve true se eh Delimitador}
begin
IsDelim:=(pos(C,'~!@# $%^&*()-+=|\}{][":'';?><./,`')<>0); {_}
end;
procedure Converte(var S:String);
var P:word;
begin
P:=pos('<',S);
while P<>0 do
begin
delete(S,P,1);
Insert('<',S,p);
P:=pos('<',S);
end;
end;
type THtml = object
private
FO:text;
public
constructor Init(FileName:string);
procedure NewLine;
procedure HWrite(S:string);
procedure WriteB(S:string);
procedure WriteI(S:string);
procedure WriteColored(S,C:string);
procedure WriteInitColor(C:string);
procedure WriteEndColor;
destructor Done;
end;
type TPasToHtm = object
private
Com,BStr:boolean;
Htm:THtml;
public
constructor Init(FileName:string);
procedure Add(pas:string);
destructor Done;
end;
constructor THtml.Init(FileName:string);
begin
Assign(FO,FileName);
ReWrite(FO);
end;
destructor THtml.Done;
begin
Close(FO);
end;
procedure THtml.NewLine;
var C:char;
begin
Writeln(FO,'');
end;
procedure THtml.HWrite(S:string);
var P:word;
begin
Write(FO,S);
end;
procedure THtml.WriteB(S:string);
begin
Converte(S);
HWrite('<b>'+S+'</b>');
end;
procedure THtml.WriteI(S:string);
begin
Converte(S);
HWrite('<i>'+S+'</i>');
end;
procedure THtml.WriteColored(S,C:string);
begin
WriteInitColor(C);
Converte(S);
HWrite(S);
WriteEndColor;
end;
procedure THtml.WriteInitColor(C:string);
begin
HWrite('<font color ="'+C+'">');
end;
procedure THtml.WriteEndColor;
begin
HWrite('</font>');
end;
constructor TPasToHtm.Init(FileName:string);
begin
Htm.Init(FileName);
Htm.HWrite('<html><body bgcolor="'+ClBack+'"><pre>');
Com:=false;
Bstr:=false;
end;
destructor TPasToHtm.Done;
begin
Htm.Done;
end;
procedure TPasToHtm.Add(Pas:string);
var P:word;
C:char;
L:word;
Cont:boolean;
Palavra:String;
OLDP:word;
HexDigit:boolean;
begin
Cont:=true;
L:=Length(pas);
if L>0 then
begin
P:=1;
while P<=L do
begin
C:=Pas[P];
Cont:=true;
if Cont and (C=chr(39))
then begin
Palavra:=C;
Inc(P);
while (Pas[P]<>chr(39)) and (P<=L) do
begin
Palavra:=Palavra+Pas[P];
inc(P)
end;
Palavra:=Palavra+Pas[P];
Converte(Palavra);
Htm.WriteColored(Palavra,clString);
Cont:=false;
end;
if Cont and ((C='{') or ( (C='(') and (P<L) and (Pas[succ(P)]='*') ))
then begin
Htm.WriteInitColor(clCom);
Com:=true;
Htm.HWrite(Pas[P]);
Cont:=false;
end;
if Cont and ( (C='/') and (P<L) and (Pas[succ(P)]='/') ) //added at 0.10
then begin
Htm.WriteInitColor(clCom);
while (P<=L) do
begin
Htm.HWrite(Pas[P]);
inc(P)
end;
Htm.WriteEndColor;
Cont:=false;
end;
if Com and Cont then
begin
while ((Pas[P]<>'}') and not ( (Pas[P]=')') and (Pas[pred(P)]='*'))) and
(P<=L) do
begin
Htm.HWrite(Pas[P]);
inc(P)
end;
if (P<=L) or (Pas[P]='}') or ( (Pas[P]=')') and (Pas[pred(P)]='*'))
then begin
Htm.HWrite(Pas[P]);
Htm.WriteEndColor;
Com:=false;
end
else Com:=true;
Cont:=false;
end;
if Cont and IsDelim(C) and not(C=' ')
then begin
Htm.WriteB(C);
Cont:=false;
end;
if Cont and
(IsDigit(C) or
( (P>1) and (Pas[pred(P)]='$') and IsHexDigit(C))) and { numero hexa?}
((P=1) or (IsDelim(Pas[pred(P)])))
then begin
HexDigit:=((P>1) and (Pas[pred(P)]='$'));
Htm.WriteInitColor(clNumber);
while ((IsDigit(Pas[P]) or (Pas[P]='.'))or
(HexDigit and IsHexDigit(Pas[P])))
and (P<=L) do
begin
Htm.Hwrite(Pas[P]);
inc(P);
end;
dec(P);
Htm.WriteEndColor;
Cont:=false;
end; { of internal if }
if Cont and IsAlpha(C) and
((P=1) or (IsDelim(Pas[pred(P)])))
then begin
OLDP:=P;
Palavra:='';
while not(IsDelim(Pas[P])) and (P<=L) do
begin
Palavra:=Palavra+Pas[P];
inc(P);
end;
dec(P);
if IsReserved(Palavra)
then begin
Htm.WriteB(Palavra);
end
else Htm.HWrite(Palavra);
Cont:=false;
end; { of medium if }
if Cont
then Htm.HWrite(C);
inc(P);
end; { while }
end; { of if }
Htm.NewLine;
end;
Procedure ConvertPasToHtm(InputFileName,OutPutFileName:String);
{ do it ! }
var PH:TPasToHtm;
S:string;
FI:Text;
begin
Assign(FI,InputFileName);
Reset(FI);
PH.Init(OutPutFileName);
while Not(Eof(FI)) do
begin
Readln(FI,S);
PH.Add(S);
end;
Close(FI);
PH.Done;
end;
procedure SetColors(Com,Str,Dig,Back:string);
{ Set the colors used by ConvertPasToHtm procedure}
begin
clString:=Str;
clCom:= Com;
clNumber:= Dig;
clBack:=Back;
end;
begin
clString:='00A000';
clCom:= '0000A0';
clNumber:= 'A00000';
clBack:='FFFFFF';
end. { of unit }