home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 08 / briefe / parser.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-06  |  12.5 KB  |  415 lines
  1. (* ----------------------------------------------------- *)
  2. (*                      PARSER.PAS                       *)
  3. (*         (c) 1990  Siegfried Hund & TOOLBOX            *)
  4. (*                                                       *)
  5. (*   V 1.0: toolbox 5'90 --> erste Fassung   (wr)        *)
  6. (*          toolbox 8'90 --> "( *" und "(."  (ga)        *)
  7. (* ----------------------------------------------------- *)
  8. PROGRAM Parser;
  9.  
  10. USES Crt, Dos, Printer;
  11.  
  12. TYPE
  13.   Zeiger = ^Satz;
  14.   Satz   = RECORD
  15.              inhalt    : STRING [20];
  16.              ingross   : STRING [20];
  17.              naechster : zeiger;
  18.             END;
  19.  
  20. VAR
  21.   anfangszeiger              : zeiger;
  22.   hilfszeiger                : zeiger;
  23.   laufzeiger                 : zeiger;
  24.   datensatz                  : Satz;
  25.   datei, orgdatei            : STRING;
  26.   newdatei, pasdatei         : STRING;
  27.   parswort, verarb           : STRING;
  28.   textdatei                  : Text;
  29.   parsdatei                  : Text;
  30.   neuetextdatei              : Text;
  31.   ok, ok1                    : BOOLEAN;
  32.   ch, ch1, taste, lastch     : CHAR;
  33.   zeile, wort, grwort        : STRING;
  34.   textzeile                  : STRING;
  35.   x, y                       : BYTE;
  36.   i, tzlen                   : INTEGER;
  37.  
  38.   { Text schreiben an der Position x und y }
  39.  
  40.   PROCEDURE WriteXY(x, y : BYTE; txt : STRING);
  41.   BEGIN
  42.     GotoXY(x, y);
  43.     Write(txt);
  44.   END;
  45.  
  46.   PROCEDURE Maske;                 { Überschrift }
  47.   BEGIN
  48.     ClrScr;
  49.     WriteXY(1, 1, '   Pascal-Parser    Version 1.0   (C)' + 
  50.           '   1990  Siegfried Hund & TOOLBOX    ');
  51.   END;
  52.  
  53.   PROCEDURE DateiToHeap;
  54.   { Datei PARSPAS.TXT als vekettete Liste auf den Heap }
  55.   BEGIN
  56.     Assign(parsdatei, 'PARSPAS.TXT');
  57. {$I-}
  58.     Reset(parsdatei);
  59.     IF IOResult <> 0 THEN BEGIN
  60.       WriteLn;
  61.       WriteLn('Fehler:  Datei PARSPAS.TXT im Path ',
  62.               'nicht vorhanden');
  63.       WriteLn;
  64.       WriteLn('Hinweis: Die Datei PARSPAS.TXT muß mit ', 
  65.               'dem Programm ');
  66.       WriteLn('         PARSER.EXE im gleichen Path ', 
  67.               'vorhanden sein.');
  68.       WriteLn;
  69.       WriteLn('Das Programm wird jetzt abgebrochen');
  70.       WriteLn;
  71.       Halt(1);
  72.     END;
  73. {$I+}
  74.     anfangszeiger := NIL;
  75.     While NOT EoF(parsdatei) DO BEGIN
  76.       New(hilfszeiger);
  77.       Read(parsdatei, parswort, ch, ch);
  78.       grwort := '';
  79.       FOR i := 1 TO Length(parswort) DO
  80.         grwort := grwort + UpCase(parswort[ i ]);
  81.       hilfszeiger^.ingross := grwort;
  82.       hilfszeiger^.naechster := NIL;
  83.       hilfszeiger^.inhalt := parswort;
  84.       grwort := '';
  85.       IF anfangszeiger = NIL THEN
  86.         anfangszeiger := hilfszeiger
  87.       ELSE BEGIN
  88.         laufzeiger := anfangszeiger;
  89.         While laufzeiger^.naechster <> NIL DO
  90.           laufzeiger := laufzeiger^.naechster;
  91.         laufzeiger^.naechster := hilfszeiger;
  92.       END;
  93.     END;
  94.   END;
  95.  
  96.   PROCEDURE ParamTest;
  97.   BEGIN
  98.     ok  := FALSE;
  99.     ok1 := FALSE;
  100.     IF ParamCount = 0 THEN BEGIN
  101.       GotoXY(1, 5);
  102.       Write('Path und Dateiname(ohne .PAS) : ');
  103.       Read(datei);
  104.       FOR i := 1 TO Length(datei) DO
  105.         datei[i] := UpCase(datei[i]);
  106.       ok := TRUE;
  107.     END;
  108.     IF ParamCount = 1 THEN BEGIN
  109.       datei := ParamStr(1);
  110.       ok := TRUE;
  111.     END;
  112.     IF ParamCount = 2 THEN BEGIN
  113.       datei := ParamStr(1);
  114.       ok := TRUE;
  115.       verarb := ParamStr(2);
  116.       taste := verarb[1];
  117.       taste := UpCase(taste);
  118.       IF taste IN ['d', 'D', 'f', 'F', 's', 'S'] THEN
  119.         ok1 := TRUE
  120.       ELSE
  121.         ok1 := FALSE;
  122.     END;
  123.     IF ok THEN BEGIN
  124.       ok := FALSE;
  125.       pasdatei := datei + '.PAS';
  126.       Assign(textdatei, pasdatei);
  127. {$I-}
  128.       Reset(textdatei);
  129.       IF IOResult <> 0 THEN BEGIN
  130.         WriteLn;
  131.         WriteLn('Fehler:  Datei ', pasdatei, 
  132.                 ' im Path nicht vorhanden');
  133.         WriteLn;
  134.         WriteLn('Hinweis: Programm erneut aufrufen ', 
  135.                 'und den richtigen ');
  136.         WriteLn('         Path und Dateinamen ohne ', 
  137.                 '.PAS angeben.     ');
  138.         WriteLn;
  139.         WriteLn('Das Programm wird jetzt abgebrochen');
  140.         WriteLn;
  141.         Halt(1);
  142.         WriteLn;
  143.         WriteLn('Datei im Path nicht vorhanden');
  144.         ok := FALSE;
  145.       END ELSE
  146.         ok := TRUE;
  147. {$I+}
  148.       IF ok1 = FALSE THEN BEGIN
  149.         WriteLn;
  150.         WriteLn('Verarbeitungs-Parameter fehlt         ');
  151.         WriteLn;
  152.         WriteLn('Zugelassene Parameter sind :   ');
  153.         WriteLn;
  154.         WriteLn('S    -->  Ausgabe nur auf dem Bildschirm');
  155.         WriteLn('D    -->  Ausgabe nur auf dem Drucker   ');
  156.         WriteLn('F    -->  Ausgabe in die Datei  *.PAS   ');
  157.         WriteLn;
  158.         Write('Parameter eingeben:  ');
  159.         REPEAT
  160.           taste := ReadKey;
  161.           taste := UpCase(taste);
  162.         UNTIL taste IN ['d', 'D', 'f', 'F', 's', 'S'];
  163.         Write(taste);
  164.         WriteLn;
  165.         ok1 := TRUE;
  166.       END;
  167.     END;
  168.   END;
  169.  
  170.   PROCEDURE PasToOrg;
  171.   { Die Datei xxx.PAS in XXX.ORG umbenennen }
  172.   BEGIN
  173.     IF ok THEN BEGIN
  174.       pasdatei := datei + '.PAS';
  175.       orgdatei := datei + '.ORG';
  176.       Rename(textdatei, orgdatei);
  177.       WriteLn('Die Datei ', pasdatei, ' wurde in Datei ', 
  178.               orgdatei, ' umbenannt ');
  179.       WriteLn;
  180.       Assign(textdatei, orgdatei);
  181. {$I-}
  182.       Reset(textdatei);
  183.       IF IOResult <> 0 THEN BEGIN
  184.         WriteLn;
  185.         WriteLn('Datei im Path nicht vorhanden');
  186.         WriteLn;
  187.         ok := FALSE;
  188.       END ELSE ok := TRUE;
  189. {$I+}
  190.     END;
  191.   END;
  192.  
  193.   PROCEDURE sauberlauf;
  194.   { Die Zeichen Klammer/Stern und Stern/Klammer für }
  195.   { Kommetare in geschweifte Klammern und die Zeichen }
  196.   { Klammer/Punkt und Punkt/Klammer in eckige Klammern }
  197.   { umwandeln. Der neue Pascal-Source wird in der }
  198.   { temporären Datei xxx.$$$ abgelegt. }
  199.   VAR
  200.     ntext  : STRING;
  201.     htext  : STRING;
  202.   BEGIN
  203.     IF ok THEN BEGIN
  204.       orgdatei := datei + '.ORG';
  205.       newdatei := datei + '.$$$';
  206.       Assign(neuetextdatei, newdatei);
  207.       Assign(textdatei, orgdatei);
  208. {$I-}
  209.       Rewrite(neuetextdatei);
  210.       Reset(textdatei);
  211.       IF IOResult <> 0 THEN BEGIN
  212.         WriteLn('Datei im Path nicht vorhanden');
  213.         WriteLn;
  214.         ok := FALSE;
  215.       END ELSE ok := TRUE;
  216. {$I+}
  217.       REPEAT
  218.         Read(textdatei, textzeile, ch, ch1);
  219.         { geschweifte Klammer auf, für Kommentare }
  220.         i := Pos('(* ', textzeile);
  221.         While i <> 0 DO  BEGIN
  222.           Delete(textzeile, i, 2);
  223.           Insert('{ ', textzeile, i);
  224.           i := Pos('(*', textzeile);
  225.         END;
  226.         { geschweifte Klammer zu, für Kommentare }
  227.         i := Pos('*)', textzeile);
  228.         While i <> 0 DO BEGIN
  229.           Delete(textzeile, i, 2);
  230.           Insert(' }', textzeile, i);
  231.           i := Pos('*)', textzeile);
  232.         END;
  233.         { eckige Klammer auf }
  234.         i := Pos('(.', textzeile);
  235.         While i <> 0 DO BEGIN
  236.           Delete(textzeile, i, 2);
  237.           Insert('[ ', textzeile, i);
  238.           i := Pos('(.', textzeile);
  239.         END;
  240.         { eckige Klammer zu }
  241.         i := Pos('.)', textzeile);
  242.         While i <> 0 DO BEGIN
  243.           Delete(textzeile, i, 2);
  244.           Insert(' ]', textzeile, i);
  245.           i := Pos('.)', textzeile);
  246.         END;
  247.         Write(neuetextdatei, textzeile, ch, ch1);
  248.       UNTIL EoF(textdatei);
  249.       Close(neuetextdatei);
  250.       ok := TRUE;
  251.     END ELSE ok := FALSE;
  252.     IF ok THEN BEGIN
  253.       pasdatei := datei + '.PAS';
  254.       newdatei := datei + '.$$$';
  255.       Assign(textdatei, newdatei);
  256. {$I-}
  257.       Reset(textdatei);
  258.       IF IOResult <> 0 THEN BEGIN
  259.         WriteLn;
  260.         WriteLn('Datei im Path nicht vorhanden');
  261.         ok := FALSE;
  262.       END ELSE ok := TRUE;
  263. {$I+}
  264.     END;
  265.   END;
  266.  
  267.   PROCEDURE parspascal;
  268.   { Die Pascal-Schlüsselworte suchen und }
  269.   { in die richtige Schreibweise umsetzen }
  270.   BEGIN
  271.     hilfszeiger := anfangszeiger;
  272.     While (hilfszeiger <> NIL) AND
  273.           ( hilfszeiger^.ingross <> wort) DO
  274.       hilfszeiger := hilfszeiger^.naechster;
  275.     IF wort = hilfszeiger^.ingross THEN
  276.       zeile := hilfszeiger^.inhalt;
  277.   END;
  278.  
  279.   PROCEDURE Bearbeiten;
  280.   { Die Datei xxx.$$$ zeichenweise lesen, die Schlüssel-   }
  281.   { worte herausfiltern und ersetzen, sowie die            }
  282.   { Kommentarzeilen und die Texte in Hochkommata von einer }
  283.   { Umwandlung ausnehmen. Der neue Pascal-Source wird in   }
  284.   { der Datei xxx.PAS abgelegt. Bei der Bildschirmausgabe  }
  285.   { und Drucker-Ausgabe wird keine neue Datei xxx.PAS      }
  286.   { erzeugt. }
  287.   BEGIN
  288.     textzeile := '';
  289.     lastch := ' ';
  290.     IF taste = 'F' THEN BEGIN
  291.       Assign(neuetextdatei, pasdatei);
  292.       Rewrite(neuetextdatei);
  293.     END;
  294.     REPEAT
  295.       zeile := '';
  296.       REPEAT
  297.         Read(textdatei, ch);
  298.         IF (lastch = ',') AND (ch <> ' ') THEN BEGIN
  299.           textzeile := textzeile + ', ';
  300.           lastch := ' ';
  301.         END ELSE
  302.           IF (lastch = ',') AND (ch = ' ') THEN BEGIN
  303.             textzeile := textzeile + lastch;
  304.             lastch := ' ';
  305.           END;
  306.         IF (lastch = ':') AND (ch = '=') THEN BEGIN
  307.           tzlen := Length(textzeile);
  308.           IF textzeile[ tzlen ] <> ' ' THEN
  309.             textzeile := textzeile + ' ' + lastch + ch
  310.           ELSE
  311.             textzeile := textzeile + lastch + ch;
  312.           Read(textdatei, ch);
  313.           IF ch <> ' ' THEN BEGIN
  314.             textzeile := textzeile + ' ';
  315.             lastch := ' ';
  316.           END;
  317.         END ELSE
  318.           IF (lastch = ':') AND (ch <> '=') THEN BEGIN
  319.             textzeile := textzeile + lastch;
  320.             lastch := ' ';
  321.           END;
  322.         IF (lastch IN [ '+', '-', '*', '/' ]) THEN BEGIN
  323.           tzlen := Length(textzeile);
  324.           IF textzeile[ tzlen ] <> ' ' THEN
  325.             textzeile := textzeile + ' ' + lastch
  326.           ELSE
  327.             textzeile := textzeile + lastch;
  328.           IF ch <> ' ' THEN textzeile := textzeile + ' ';
  329.           IF ch =  ' ' THEN textzeile := textzeile;
  330.           lastch := ' ';
  331.         END;
  332.         While ch IN [ 'A'..'Z', 'a'..'z' ] DO BEGIN
  333.           zeile := zeile + ch;
  334.           Read(textdatei, ch);
  335.         END;
  336.         IF zeile > '' THEN BEGIN
  337.           wort := zeile;
  338.           FOR i := 1 TO Length(wort) DO
  339.             wort[i] := UpCase(wort[i]);
  340.           parspascal;
  341.           textzeile := textzeile + zeile;
  342.           zeile := '';
  343.         END;
  344.         IF ch = Chr(39) THEN BEGIN
  345.           textzeile := textzeile + ch;
  346.           REPEAT
  347.             Read(textdatei, ch);
  348.             textzeile := textzeile + ch;
  349.           UNTIL ch = Chr(39);
  350.           Read(textdatei, ch);
  351.         END;
  352.         IF ch = '{' THEN BEGIN
  353.           REPEAT
  354.             IF ch IN [ #13, #10 ] THEN BEGIN
  355.               CASE taste OF
  356.                 'S' : Write(textzeile);
  357.                 'D' : Write(Lst, textzeile);
  358.                 'F' : Write(neuetextdatei, textzeile);
  359.               END;
  360.               textzeile := '';
  361.             END;
  362.             textzeile := textzeile + ch;
  363.             Read(textdatei, ch);
  364.           UNTIL ch = '}';
  365.         END;
  366.         IF ch IN [',', '+', '-', '*', '/', ':'] THEN
  367.           lastch := ch
  368.         ELSE BEGIN
  369.           textzeile := textzeile + ch;
  370.           lastch := ' ';
  371.         END;
  372.       UNTIL ch IN [#13, #10];
  373.       CASE taste OF
  374.         'S' : Write(textzeile);
  375.         'D' : Write(Lst, textzeile);
  376.         'F' : Write(neuetextdatei, textzeile);
  377.       END;
  378.       textzeile := '';
  379.     UNTIL EoF(textdatei);
  380.     IF ok THEN Close(textdatei) ELSE Delay(2500);
  381.     IF taste = 'F' THEN Close(neuetextdatei);
  382.   END;
  383.  
  384. BEGIN
  385.   ClrScr;
  386.   Maske;
  387.   Window(1, 3, 80, 25);
  388.   ClrScr;
  389.   DateiToHeap;  { Parser-Datei auf Heap laden }
  390.   ParamTest;    { Parameter vorhanden ? }
  391.   PasToOrg;     { Rename xxx.PAS in xxx.ORG }
  392.   sauberlauf;   { Klammern korrigieren }
  393.   IF ok AND ok1 THEN BEGIN
  394.     Bearbeiten;
  395.     Erase(textdatei);
  396.     CASE taste OF
  397.       'S', 'D' : BEGIN
  398.                    Assign(textdatei, orgdatei);
  399.                    Rename(textdatei, pasdatei);
  400.                  END;
  401.       'F'      : BEGIN
  402.                    WriteLn('Die Originaldatei wurde in  ', 
  403.                            orgdatei, ' umbenannt');
  404.                    WriteLn('Die erzeugte Datei wurde als ', 
  405.                             pasdatei, ' gespeichert');
  406.                    WriteLn;
  407.                  END;
  408.     END;
  409.     WriteLn('Programm beendet');
  410.   END ELSE WriteLn('Das Programm wurde abgebrochen');
  411. END.
  412. {  ------------------------------------------------------  }
  413. {                 Ende von PARSER.PAS                      }
  414.  
  415.