Turbo Toolbox/Turbo_Toolbox.iso/extra18/optipas/pretty.inc

Text File | 1991-12-04 | 11.4 KB | 382 lines

(* ------------------------------------------------- *)
(*                  PRETTY.INC                       *)
(*    Include-File - wird in PRETTY.PAS geladen      *)
(*    Sprache  : Turbo Pascal Version 6.0            *)
(*   (c) 1991 Wilfried Lottermoser & DMV-Verlag      *)
(* ------------------------------------------------- *)
CONST
  tempfilename  = 'temp.$$$';

VAR
  quelldatei,
  zieldatei,
  bakdatei      : TEXT;


  FUNCTION Optimize(quellname       : STRING;
                    stand, struktur,
                    platzspar       : BOOLEAN;
                    einruecktiefe,
                    maxzeilenlaenge : BYTE) : WORD;

CONST
  Buchstaben   : SET OF CHAR =
    ['A'..'Z', 'a'..'z', '_'];
  trennzeichen : SET OF CHAR =
    [' ', ';', ',', '+', '-', '=', '*', '/', '.'];

  tab = 8;

  anfangworte  : ARRAY[1..11] OF STRING[6] =
    ('BEGIN', 'REPEAT', 'CASE', 'RECORD', 'IF', 'THEN',
     'WHILE', 'UNTIL',  'ELSE', 'DO', 'OBJECT');

VAR
  bakname,
  wort, puffer   : STRING;
  zeichen        : CHAR;
  laenge,          { aktuelle Zeilenlaenge            }
  einr,            { aktuelle Einrücktiefe            }
  n, durchlaeufe : BYTE;
  neuzeile       : BOOLEAN;
                   { ist Puffer am  Zeilenanfang      }
  ebene          : ARRAY [0..255] OF RECORD
                     EndWort     : STRING[6];
                     Tiefe       : BYTE;
                     AnfZeileAlt : BOOLEAN;
                     TiefWort    : BYTE;
                   END;
  aktebene,        { aktuelle  Ebene                  }
  kommentar,       { 1=Strings   2={   3=(*           }
  caseebene      : BYTE;
  errornr        : WORD;


  FUNCTION IoError : BOOLEAN;      { IO-Fehlerabfrage }
  BEGIN
    ErrorNr := IOResult;
    IF ErrorNr > 0 THEN BEGIN
      IoError  := TRUE;
      Optimize := ErrorNr;
    END ELSE
      IoError := FALSE;
  END;

  PROCEDURE GetZeichen;
                       { liest Zeichen aus Quelldatei }
  BEGIN
    Read(QuellDatei, Zeichen);
    Inc(Laenge);
  END;

  PROCEDURE WritePuffer;
    { schreibt Puffer in Datei ggf.
      mit #13#10 & Einrücken }
  VAR
    i : BYTE;
  BEGIN
    IF Eof(QuellDatei) THEN Puffer := Puffer + Zeichen;
    IF NeuZeile THEN
      FOR i := 1 TO Einr DO Puffer := #32 + Puffer;
    IF NeuZeile THEN Puffer := #13#10 + Puffer;
    Write(Zieldatei, Puffer);
  END;

  PROCEDURE Return;
    { liest #13#10 und Einrückleerzeichen + Tabs }
  VAR
    i : BYTE;
  BEGIN
    Einr := 0;  NeuZeile := TRUE;
    IF Zeichen = #13 THEN GetZeichen;
    IF Zeichen = #10 THEN GetZeichen;
    WHILE Zeichen IN [#32, #9] DO BEGIN
      IF Zeichen = #32 THEN
        Inc(Einr)
      ELSE
        Einr := Einr + Tab;
      GetZeichen;
    END;
    FOR i := 1 TO AktEbene DO
      Ebene[i].AnfZeileAlt := TRUE;
    IF (AktEbene > 0) THEN
      WITH Ebene[AktEbene] DO BEGIN
        IF (Endwort = 'THEN') OR
           { Einrücktiefe & Länge für Ebene bestimmen }
           (Endwort = 'DO') OR
           (Endwort = 'until;') THEN
          Einr := Tiefwort
           { Alles unter Bedingung einrücken }
        ELSE Einr := Tiefe + Einruecktiefe;
    END;
    IF Einr > MaxZeilenLaenge DIV 2 THEN
      einr := MaxZeilenlaenge DIV 2;
    Laenge := Einr;
  END;

  PROCEDURE Semikolon;
    { beendet THEN-,ELSE-,DO-,
      UNTIL-schleifen bei Semikolon }
  BEGIN
    WHILE ((Ebene[Aktebene].Endwort = 'ELSE')   OR
           (Ebene[Aktebene].Endwort = 'until;') OR
           (Ebene[Aktebene].Endwort = 'case:;') OR
           (Ebene[Aktebene].Endwort = 'else;')  OR
           (Ebene[Aktebene].endwort = 'do;'))   AND
           (Aktebene > 0) DO Dec(Aktebene);
  END;

  PROCEDURE WortAnalyse;
    { Erstellen und Löschen von Strukturierungsebenen }
  VAR
    i      : BYTE;
    UpWort : STRING;
  BEGIN
    UpWort := Up(Wort);
    IF Stand THEN StandSchrW(UpWort, Wort);
      { Standardschreibweise s. Unit }
    IF Struktur THEN BEGIN
      IF Aktebene > 0 THEN BEGIN
        WHILE ((UpWort = 'ELSE') OR (UpWort = 'END') OR
               (Upwort = 'UNTIL')) AND
              ((Ebene[AktEbene].Endwort = 'ELSE')    OR
               (Ebene[AktEbene].Endwort = 'until;')  OR
               (Ebene[AktEbene].Endwort = 'case:;')  OR
               (Ebene[AktEbene].Endwort = 'else;')   OR
               (Ebene[AktEbene].Endwort = 'do;'))   AND
               (Ebene[AktEbene].Endwort <> UpWort)   DO
        Dec(AktEbene);
        IF UpWort = Ebene[AktEbene].Endwort THEN BEGIN
          IF Ebene[AktEbene].AnfZeileAlt THEN BEGIN
            IF NOT(NeuZeile) THEN NeuZeile := TRUE;
            Laenge := Laenge - Einr;
              { Länge & Einr neu bestimmen }
            Einr := Ebene[AktEbene].Tiefe;
            Laenge := Laenge + Einr;
          END;
          Dec(AktEbene);
        END;
      END;
      IF (Upwort = 'CASE') AND (CaseEbene = 0) THEN
        CaseEbene := AktEbene;
      IF (Upwort = 'END') AND
         (CaseEbene = AktEbene) THEN CaseEbene := 0;
      IF (Upwort = 'ELSE') AND
         (CaseEbene = Aktebene-1) THEN
           { case-else einrücken }
        Einr := Ebene[AktEbene].Tiefe + EinrueckTiefe;
      FOR i := 1 TO 11 DO
        IF Upwort = AnfangWorte[i] THEN
          WITH Ebene[AktEbene+1] DO BEGIN
            Inc(AktEbene);
            CASE i OF
              1,3,4,11 : Endwort := 'END';
              2        : Endwort := 'UNTIL';
              5        : Endwort := 'THEN';
              6        : Endwort := 'ELSE';
              7        : Endwort := 'DO';
              8        : Endwort := 'until;';
              9        : Endwort := 'else;';
              10       : Endwort := 'do;'
            END;
            IF NOT (PlatzSpar) AND (i IN [4,11]) THEN
              Tiefe := laenge-6
              { Record-, object-end bündig }
            ELSE
              Tiefe := Einr;
            IF i IN [5,7,8] THEN BEGIN
              WHILE zeichen = #32 DO BEGIN
                GetZeichen;
                Wort := Wort + #32;
              END;
              Tiefwort := Laenge;
                { if-,while,-until,-
                  Bedingung untereinander }
            END;
            Anfzeilealt := FALSE;
          END;
    END;
  END;

  PROCEDURE Ueberlaenge;
    { Zeilenlängenformatierung der Quelldatei }
  VAR
    hPuffer        : STRING;
    Merk39,          { Anführungszeichen              }
    Anfuerzeichen  : BOOLEAN;
                     { Anführungszeichen gepuffert    }
    i              : BYTE;
  BEGIN
    Laenge        := 0;
    Einr          := 0;
    Anfuerzeichen := FALSE;
    Merk39        := FALSE;
    GetZeichen;
    WHILE NOT (Eof(QuellDatei) OR (ErrorNr>0)) DO BEGIN
      Puffer   := '';
      NeuZeile := FALSE;
      IF Zeichen IN [#10, #13] THEN Return;
      WHILE NOT ((Zeichen IN Trennzeichen+[#10,#13]) OR
                  Eof(Quelldatei)) DO BEGIN
        IF (Zeichen = #39) THEN Merk39 := NOT(Merk39);
        Puffer := Puffer + Zeichen;
        GetZeichen;
      END;
      WHILE Zeichen IN Trennzeichen DO BEGIN
        Puffer := Puffer + Zeichen;
        GetZeichen;
      END;
      IF Laenge > MaxZeilenlaenge-1 THEN BEGIN;
        { neue Zeile und Stringtrennung }
      hPuffer := #13#10;
      IF Anfuerzeichen THEN hPuffer := #39 + hPuffer;
      FOR i := 1 TO Einr DO hPuffer := hPuffer + #32;
      IF Anfuerzeichen AND (Puffer[1] <> #39) THEN
        Puffer := '+' + #39 + Puffer;
      IF Anfuerzeichen AND (Puffer[1] = #39) THEN
        { kein +'' }
        Puffer := Copy(Puffer, 2, Length(Puffer));
        Laenge := Einr + Length(Puffer);
        Puffer := hPuffer + Puffer;
      END;
      Anfuerzeichen := Merk39;
      WritePuffer;
    END;
  END;

  PROCEDURE UeberLesen(ch : CHAR);
    { Überlesen aller Strings und Kommentare }
  BEGIN
    Puffer := Puffer + ch;
    GetZeichen;
    CASE ch OF
      #39 : IF Kommentar = 1 THEN Kommentar := 0;
      '}' : IF Kommentar = 2 THEN Kommentar := 0;
      '*' : IF Zeichen = ')' THEN
              IF Kommentar = 3 THEN Kommentar := 0;
    END;
  END;

  PROCEDURE ZeichenAnalyse(ch : CHAR);
  BEGIN
    Puffer := Puffer + ch;
    GetZeichen;
    CASE ch OF
      #39 : IF Kommentar = 0 THEN Kommentar := 1;
      '{' : IF Kommentar = 0 THEN Kommentar := 2;
      '(' : IF Zeichen   = '*' THEN
              IF Kommentar = 0 THEN Kommentar := 3;
      ';' : BEGIN
              Semikolon;
              IF NOT(Platzspar) THEN
                IF Zeichen <> #32 THEN
                  Puffer := Puffer + #32
            END;
      ':' : IF NOT(Platzspar) THEN BEGIN
              WHILE zeichen=#32 DO BEGIN
                Puffer := Puffer + Zeichen;
                GetZeichen;
              END;
              IF (CaseEbene > 0) AND
                  NOT (Zeichen IN ['0'..'9', '=']) THEN
                   { caselabel? }
                WITH Ebene[AktEbene+1] DO BEGIN
                  Inc(AktEbene);
                  Tiefe   := Laenge;
                  Einr    := Tiefe;
                  EndWort := 'case:;';
                END;
            END;
    END;
  END;

  PROCEDURE Strukturierung;
  VAR
    i : BYTE;
  BEGIN
    Laenge    := 0;
    Einr      := 0;
    AktEbene  := 0;
    CaseEbene := 0;
    Kommentar := 0;
    GetZeichen;
    WHILE NOT (Eof(QuellDatei) OR
              (ErrorNr > 0)) DO BEGIN
      Puffer   := '';
      Wort     := '';
      NeuZeile := FALSE;
      IF Zeichen IN [#10,#13] THEN Return;
      IF NOT (Zeichen IN [#10,#13]) THEN
        IF Kommentar = 0 THEN BEGIN
          WHILE Zeichen IN Buchstaben DO BEGIN
            Wort := Wort + Zeichen;
            GetZeichen;
          END;
          IF Wort = '' THEN
            ZeichenAnalyse(Zeichen)
          ELSE BEGIN
            WortAnalyse;
            Puffer := Wort;
          END;
        END ELSE
          Ueberlesen(Zeichen);
      IF Kommentar = 0 THEN
        WHILE NOT ((zeichen IN
           [#39,'{','(',';',':',#10,#13]+Buchstaben) OR
             Eof(QuellDatei)) DO BEGIN
          Puffer := Puffer + Zeichen;
          GetZeichen;
        END
      ELSE
        WHILE NOT ((Zeichen IN
           [#39,'}','*',#10,#13]) OR
             Eof(QuellDatei) ) DO BEGIN
          Puffer := Puffer + Zeichen;
          GetZeichen;
        END;
      WritePuffer;
    END;
  END;

BEGIN
  BakName := Copy(QuellName, 1,
             Length(QuellName)-4) + '.' + 'BAK';
  IF MaxZeilenlaenge < 255 THEN
    Durchlaeufe := 3
  ELSE
    Durchlaeufe := 1;
  FOR n := 1 TO Durchlaeufe DO BEGIN
    Assign(QuellDatei, QuellName);
    Reset(QuellDatei);
    IF IoError THEN Exit;
    Assign(ZielDatei, TempFileName);
    Rewrite(ZielDatei);
    IF IoError THEN Exit;
    Assign(BakDatei, BakName);
    CASE n OF
      1 : Strukturierung;
      2 : Ueberlaenge;
      3 : Strukturierung;
    END;
    IF (ErrorNr > 0) THEN Exit;
    Close(ZielDatei);
    IF IoError THEN Exit;
    Close(QuellDatei);
    IF IoError THEN Exit;
    IF n = 1 THEN BEGIN
      Erase(BakDatei);
      IF IOResult = 0 THEN ;
      Rename(QuellDatei, BakName);
      IF IoError THEN Exit;
    END ELSE
      Erase(QuellDatei);
    IF IoError THEN Exit;
    Rename(Zieldatei, QuellName);
    IF IoError THEN Exit;
  END;
  Optimize := ErrorNr;
END;
(* ------------------------------------------------- *)
(*                Ende von PRETTY.INC                *)