pas2html.pas

 1   program PAS2HTML; 
 2      {$I-}   {$B-} 
 3    
 4      { PAS2HTML 
 5      program pro převod Pascalských zdrojových textů do (X)HTML 
 6      (c) 1996, 2009 Pavel Satrapa} 
 7    
 8   uses Objects, Dos; 
 9    
 10   const Verze = '1.10'; 
 11    
 12         JmenoKlicu = 'keyws.def'; 
 13         JmenoZnaku = 'chars.def'; 
 14    
 15   type PKlicSlovo = ^KlicSlovo; 
 16        KlicSlovo = record 
 17          Slovo : string[20]; 
 18          Dalsi : PKlicSlovo; 
 19         end; 
 20    
 21   var JmenoZdroje, JmenoSazby : string; 
 22       Zdroj, Sazba : Text; 
 23       DomaciAdr : string; 
 24       Cislovat,    {číslovat řádky?} 
 25       Komplet,    {kompletní WWW stránku?} 
 26       Barvit,    {barvu pozadí?} 
 27       Komentar1,    {ve složených závorkách} 
 28       Komentar2 : Boolean;    {v kulatých s hvězdičkou} 
 29       Kodovani : string;    {jaké kódování se má vyznačit} 
 30       Radek : string; 
 31       CisloR : LongInt; 
 32       BGColor : string [6]; 
 33       Klice : array ['A'..'Z'] of PKlicSlovo; 
 34       Znaky : array [Char] of PString; 
 35    
 36    
 37      {*************** podpůrné podprogramy ***************} 
 38    
 39   procedure Chyba ( Napis : string ); 
 40       {vypíše chybové hlášení} 
 41    begin 
 42     Writeln ( '!!! ERROR: ', Napis ); 
 43    end; 
 44    
 45   function NaVelka ( Retezec : string ) : string; 
 46       {převede řetězec na velká písmena} 
 47       {!!! zneužívá toho, že parametr je předáván hodnotou !!!} 
 48    var I : Integer; 
 49    begin 
 50     for I := 1 to Length(Retezec) do 
 51      Retezec[I] := UpCase ( Retezec[I] ); 
 52     NaVelka := Retezec; 
 53    end; 
 54    
 55    
 56      {*************** vlastní sazba ***************} 
 57    
 58   procedure ZpracujRadek; 
 59       {vysází jeden řádek vstupu} 
 60   var Pozice : Integer;    {index zpracovávaného znaku} 
 61    
 62    procedure PisZnak ( Znak : Char ); 
 63        {zapíše do výstupu text, odpovídající danému znaku} 
 64     begin 
 65      Write ( Sazba, Znaky[Znak]^ ); 
 66     end; 
 67    
 68    procedure PisAPostup; 
 69        {vypíše aktuální znak řádku a popojde na další} 
 70     begin 
 71      PisZnak ( Radek[Pozice] ); 
 72      Pozice := Pozice + 1; 
 73     end; 
 74    
 75    function PristiZnak : Char; 
 76        {vydá znak, který v řádku následuje za aktuálním} 
 77     begin 
 78      if Pozice < Length(Radek) then 
 79        PristiZnak := Radek[Pozice+1] 
 80       else 
 81        PristiZnak := Chr(0); 
 82     end; 
 83    
 84    procedure ZpracujSlovo; 
 85        {načte slovo a vypíše jako identifikátor nebo klíč} 
 86    
 87     function JeKlic ( Slovo : string ) : Boolean; 
 88         {je 'Slovo' v tabulce klíčových slov ?} 
 89      var Pom : PKlicSlovo; 
 90          JeToKlic : Boolean; 
 91      begin 
 92       JeToKlic := False; 
 93       Pom := Klice[Slovo[1]]; 
 94       while not JeToKlic and (Pom <> nil) do 
 95        if Slovo = Pom^.Slovo then JeToKlic := True 
 96         else Pom := Pom^.Dalsi; 
 97       JeKlic := JeToKlic; 
 98      end; 
 99    
 100     var Slovo : string; 
 101     begin    {ZpracujSlovo} 
 102      Slovo := ''; 
 103      while (Pozice <= Length(Radek)) and 
 104            (Radek[Pozice] in ['a'..'z','A'..'Z','_','0'..'9']) do 
 105       begin 
 106        Slovo := Slovo + Radek[Pozice]; 
 107        Pozice := Pozice + 1; 
 108       end; 
 109      if JeKlic ( NaVelka(Slovo) ) then 
 110         Write ( Sazba, '<b>', Slovo, '</b>' ) 
 111       else 
 112         Write ( Sazba, '<i>', Slovo, '</i>' ); 
 113     end;    {ZpracujSlovo} 
 114    
 115    procedure PreskocMezery; 
 116        {vypustí mezery ze začátku řádku} 
 117     var PocetMezer, I : Integer; 
 118         Dal : Boolean; 
 119     begin 
 120      I := 1; 
 121      Dal := I <= Length ( Radek ); 
 122      while Dal do 
 123       if Radek[I] <> ' ' then Dal := False 
 124        else 
 125         begin 
 126          I := I + 1; 
 127          Dal := I <= Length ( Radek ); 
 128         end; 
 129      PocetMezer := I - 1; 
 130      Delete ( Radek, 1, PocetMezer ); 
 131      if Cislovat then 
 132        Write ( Sazba, '<tr><td align="right">&nbsp;<small>', CisloR, 
 133                       '</small>&nbsp;&nbsp;&nbsp;</td><td>' ) 
 134       else 
 135        Write ( Sazba, '<tr><td>&nbsp;' ); 
 136      if (Radek <> '') and (PocetMezer > 0) then 
 137        begin 
 138         Write ( Sazba, '<tt>' ); 
 139         for I := 1 to PocetMezer do 
 140           Write ( Sazba, '&nbsp;' ); 
 141         Write ( Sazba, '</tt>' ); 
 142        end; 
 143     end; 
 144    
 145    procedure DokonciKomentar1; 
 146        {hledá koncovou složenou závorku, text opisuje} 
 147     var Dal : Boolean; 
 148     begin 
 149      Dal := Pozice <= Length(Radek); 
 150      while Dal do 
 151       begin 
 152        if Radek[Pozice] = '}' then 
 153          begin 
 154           Komentar1 := False; 
 155           Dal := False; 
 156          end 
 157         else Dal := Pozice < Length(Radek); 
 158        PisAPostup; 
 159       end; 
 160     end; 
 161    
 162    procedure DokonciKomentar2; 
 163        {hledá koncové '*)', text opisuje} 
 164     var Dal : Boolean; 
 165     begin 
 166      Dal := Pozice <= Length(Radek); 
 167      while Dal do 
 168       begin 
 169        if (Radek[Pozice] = '*') and 
 170           (PristiZnak = ')') then 
 171          begin 
 172           PisAPostup; 
 173           Komentar2 := False; 
 174           Dal := False; 
 175          end 
 176         else Dal := Pozice < Length(Radek); 
 177        PisAPostup 
 178       end; 
 179     end; 
 180    
 181    procedure DokonciRetezec; 
 182        {hledá ukončující apostrof, text opisuje} 
 183     begin 
 184      repeat 
 185       PisAPostup; 
 186      until Radek[Pozice]=''''; 
 187      PisAPostup; 
 188     end; 
 189    
 190    begin    {ZpracujRadek} 
 191     Inc ( CisloR ); 
 192     PreskocMezery; 
 193     if Radek <> '' then 
 194       begin 
 195        Pozice := 1; 
 196        if Komentar1 then DokonciKomentar1; 
 197        if Komentar2 then DokonciKomentar2; 
 198        while Pozice <= Length(Radek) do 
 199         case Radek[Pozice] of 
 200           'a'..'z','A'..'Z','_' : ZpracujSlovo; 
 201           '''' : DokonciRetezec; 
 202           '{' : begin 
 203                  Write ( Sazba, '&nbsp;&nbsp;&nbsp;' ); 
 204                  PisAPostup; 
 205                  Komentar1 := True; 
 206                  DokonciKomentar1; 
 207                 end; 
 208           '(' : if PristiZnak <> '*' then PisAPostup 
 209                  else 
 210                   begin 
 211                    Write ( Sazba, '&nbsp;&nbsp;&nbsp;' ); 
 212                    PisAPostup; PisAPostup; 
 213                    Komentar2 := True; 
 214                    DokonciKomentar2; 
 215                   end; 
 216           else PisAPostup; 
 217         end; 
 218       end; 
 219     Writeln ( Sazba, '&nbsp;</td></tr>' ); 
 220     if IOResult <> 0 then 
 221       Chyba ( 'By write to "' + JmenoSazby + '"' ); 
 222    end;    {ZpracujRadek} 
 223    
 224    
 225      {*************** zahájení, ukončení a spol. ***************} 
 226    
 227   procedure ZpracujParametry; 
 228       {zpracuje parametry programu} 
 229    
 230    procedure NapovedaKonec ( Kod : Integer ); 
 231       {návodný text a ukončení programu} 
 232     begin 
 233      Writeln ( ' PAS2HTML ', Verze ); 
 234      Writeln ( '===============' ); 
 235      Writeln ( 'Program for typesetting Pascal sources in HTML.' ); 
 236      Writeln ( '(c) 1996 Pavel Satrapa' ); 
 237      Writeln; 
 238      Writeln ( 'Usage: PAS2HTML [input_file [output_file]] [options]' ); 
 239      Writeln ( ' default input is standard intput' ); 
 240      Writeln ( ' default output is standard output' ); 
 241      Writeln ( ' options are:' ); 
 242      Writeln ( ' /H print this Help text' ); 
 243      Writeln ( ' /N include line Numbers to output' ); 
 244      Writeln ( ' /C=RRGGBB bacground color' ); 
 245      Writeln ( ' /F full web page' ); 
 246      Writeln ( ' /E=encoding announce given encoding (default utf=8, valid only with /F)' ); 
 247      Halt (Kod); 
 248     end; 
 249    
 250    procedure PriradJmeno ( Jmeno : string ); 
 251        {přiřazení jména souboru} 
 252     begin 
 253      if JmenoZdroje = '' then JmenoZdroje := Jmeno 
 254       else 
 255        if JmenoSazby = '' then JmenoSazby := Jmeno 
 256         else 
 257          begin 
 258           Chyba ( 'Too much parameters "' + Jmeno + '"' ); 
 259           NapovedaKonec (1); 
 260          end; 
 261     end; 
 262    
 263    var I : Integer; 
 264        Param : string; 
 265    begin    {ZpracujParametry} 
 266     JmenoZdroje := ''; 
 267     JmenoSazby := ''; 
 268     Cislovat := False; 
 269     Komplet := False; 
 270     Barvit := False; 
 271     Kodovani := 'utf-8'; 
 272     for I := 1 to ParamCount do 
 273      begin 
 274       Param := ParamStr(I); 
 275       if Param[1] in ['/','-'] then 
 276         case Param[2] of 
 277           'h', 'H', '?' : NapovedaKonec (0); 
 278           'n', 'N' : Cislovat := True; 
 279           'f', 'F' : Komplet := True; 
 280           'e', 'E' : Kodovani := Copy ( Param, 4, Length(Param) - 3 ); 
 281           'c', 'C' : begin 
 282                       Barvit := True; 
 283                       BGColor := Copy ( Param, 4, 6 ); 
 284                      end; 
 285           else 
 286            begin 
 287             Chyba ( 'Bad parameter "' + Param + '"' ); 
 288             NapovedaKonec (1); 
 289            end; 
 290         end 
 291        else 
 292         PriradJmeno ( Param ); 
 293      end; 
 294    end;    {ZpracujParametry} 
 295    
 296   procedure Inicializace; 
 297      {počáteční inicializace programu} 
 298    
 299    procedure UrciAdresar; 
 300        {najde adresář, ve kterém se nachází program} 
 301     var 
 302       EXEJmeno: PathStr; 
 303       Jmeno : NameStr; 
 304       Pripona : ExtStr; 
 305     begin 
 306      EXEJmeno := ParamStr(0); 
 307      FSplit(EXEJmeno, DomaciAdr, Jmeno, Pripona); 
 308      { if DomaciAdr [ Length(DomaciAdr) ] <> '\' then 
 309        DomaciAdr := DomaciAdr + '\'; } 
 310     end; 
 311    
 312    procedure NactiKlice; 
 313       {načte ze souboru klíčová slova a inicalizuje 'Klice'} 
 314    
 315     procedure PridejKlic ( KlSlovo : string ); 
 316        {přidá 'KlSlovo' do tabulky klíčových slov} 
 317      var NovyKlic : PKlicSlovo; 
 318      begin 
 319       New ( NovyKlic ); 
 320       NovyKlic^.Slovo := KlSlovo; 
 321       NovyKlic^.Dalsi := Klice[KlSlovo[1]]; 
 322       Klice[KlSlovo[1]] := NovyKlic; 
 323      end; 
 324    
 325     var C : Char; 
 326         KlSoub : Text; 
 327         Radek : string; 
 328     begin    {NactiKlice} 
 329      for C := 'A' to 'Z' do Klice[C] := nil; 
 330      Assign ( KlSoub, DomaciAdr + JmenoKlicu ); 
 331      Reset ( KlSoub ); 
 332      if IOResult <> 0 then 
 333        Chyba ( 'Cannot open keyword file "' + JmenoKlicu + '"' ); 
 334      while not Eof(KlSoub) do 
 335       begin 
 336        Readln ( KlSoub, Radek ); 
 337        if Pos ( ' ', Radek ) <> 0 then 
 338          Delete ( radek, Pos(' ',Radek), Length(Radek) ); 
 339        if Radek <> '' then PridejKlic ( NaVelka(Radek) ); 
 340       end; 
 341      Close ( KlSoub ); 
 342      if IOResult <> 0 then 
 343        Chyba ( 'By reading keyword file "' + JmenoKlicu + '"' ); 
 344     end;    {NactiKlice} 
 345    
 346    procedure NactiZnaky; 
 347       {načte definice speciálních znaků} 
 348     var C : Char; 
 349         ZnSoub : Text; 
 350         Radek : string; 
 351     begin 
 352      for C := Chr(0) to Chr(255) do 
 353        Znaky[C] := nil; 
 354      Assign ( ZnSoub, DomaciAdr + JmenoZnaku ); 
 355      Reset ( ZnSoub ); 
 356      if IOResult <> 0 then 
 357        Chyba ( 'Cannot open char definiton file "' + JmenoZnaku + '"' ); 
 358      while not Eof(ZnSoub) do 
 359       begin 
 360        Readln ( ZnSoub, Radek ); 
 361        if Radek <> '' then 
 362         begin 
 363          C := Radek[1]; 
 364          Delete ( Radek, 1, 2 ); 
 365          Znaky[C] := NewStr ( Radek ); 
 366         end; 
 367       end; 
 368      Close ( ZnSoub ); 
 369      if IOResult <> 0 then 
 370        Chyba ( 'By reading char definiton file "' + JmenoZnaku + '"' ); 
 371      for C := Chr(0) to Chr(255) do 
 372        if Znaky[C] = nil then Znaky[C] := NewStr ( C ); 
 373     end; 
 374    
 375    begin    {Inicializace} 
 376     UrciAdresar; 
 377     NactiKlice; 
 378     NactiZnaky; 
 379     Komentar1 := False; 
 380     Komentar2 := False; 
 381     CisloR := 0; 
 382     Assign ( Zdroj, JmenoZdroje ); 
 383     Reset ( Zdroj ); 
 384     if IOResult <> 0 then 
 385       Chyba ( 'Cannot open input file "' + JmenoZdroje + '"' ); 
 386     Assign ( Sazba, JmenoSazby ); 
 387     Rewrite ( Sazba ); 
 388     if IOResult <> 0 then 
 389       Chyba ( 'Cannot open output file "' + JmenoSazby + '"' ); 
 390     if Komplet then 
 391       begin 
 392       Writeln ( Sazba, '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"'); 
 393       Writeln ( Sazba, ' "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'); 
 394       Writeln ( Sazba, '<html xmlns="http://www.w3.org/1999/xhtml">'); 
 395       Writeln ( Sazba, '<head>'); 
 396       Writeln ( Sazba, '<meta http-equiv="content-type" content="text/html; charset=', 
 397                        Kodovani, '" />'); 
 398       Writeln ( Sazba, '<title>', JmenoZdroje, '</title>'); 
 399       Writeln ( Sazba, '</head>'); 
 400       Writeln ( Sazba, '<body>'); 
 401       Writeln ( Sazba, '<h1>', JmenoZdroje, '</h1>'); 
 402       end; 
 403     Write ( Sazba, '<table border="0" cellspacing="0" cellpadding="0"' ); 
 404     if Barvit then 
 405       Write ( Sazba, ' bgcolor="#', BGColor, '"' ); 
 406     Writeln ( Sazba, '>' ); 
 407     if IOResult <> 0 then 
 408       Chyba ( 'By writing to "' + JmenoSazby + '"' ); 
 409    end;    {Inicializace} 
 410    
 411   procedure Konec; 
 412      {zakončení programu} 
 413    begin 
 414     Close ( Zdroj ); 
 415     if IOResult <> 0 then 
 416       Chyba ( 'Cannot close input "' + JmenoZdroje + '"' ); 
 417     Writeln ( Sazba, '</table>' ); 
 418     if Komplet then 
 419       begin 
 420       Writeln ( Sazba, '</body>'); 
 421       Writeln ( Sazba, '</html>'); 
 422       end; 
 423     if IOResult <> 0 then 
 424       Chyba ( 'By writing to "' + JmenoSazby + '"' ); 
 425     Close ( Sazba ); 
 426     if IOResult <> 0 then 
 427       Chyba ( 'Cannot close output "' + JmenoSazby + '"' ); 
 428    end; 
 429    
 430    
 431      {*************** hlavní program ***************} 
 432    
 433   begin 
 434    ZpracujParametry; 
 435    Inicializace; 
 436    while not Eof(Zdroj) do 
 437     begin 
 438      Readln ( Zdroj, Radek ); 
 439      if IOResult <> 0 then 
 440        Chyba ( 'By reading from "' + JmenoSazby + '"' ); 
 441      ZpracujRadek; 
 442     end; 
 443    Konec; 
 444   end.