Listing of PLIST.PAS                                               PAGE 1


    1:  0  {****************************************************************************}
    2:  0  {*               PLIST VERSION 3.6 / 1985.3 von Ulrich Kern                 *}
    3:  0  {****************************************************************************}
    4:  0  
    5:  0  PROGRAM PLIST; {verbesserte Version von TLIST}
    6:  0  {$V-}   {Kein range-checking vei string-Uebergabe}
    7:  0  
    8:  0     CONST PL : integer = 72;
    9:  0           MT : integer =  3;
   10:  0           MB : integer =  3;
   11:  0           PO : integer =  0;
   12:  0           CP : integer =  0;
   13:  0           HE : STRING[128] = '';
   14:  0           FO : STRING[128] = '';
   15:  0  
   16:  0     TYPE  line            = STRING[128];
   17:  0           linelength      = 0..128;
   18:  0           filetype        = (main,include);
   19:  0           PufferZeiger    = ^Puffer;
   20:  0           Puffer          = RECORD
   21:  1                                Eintrag    : line;
   22:  1                                Naechster  : PufferZeiger
   23:  1                             END;
   24:  0           Bez             = STRING[20];
   25:  0  
   26:  0           ZeilenListe     = ^ZeilenEintrag;
   27:  0           ZeilenEintrag   = RECORD
   28:  1                                Nummer    : integer;
   29:  1                                ZNext     : ZeilenListe
   30:  1                             END;
   31:  0  
   32:  0               IdentList  = ^Bezeichner;
   33:  0               Bezeichner = RECORD
   34:  1                               IName : Bez;
   35:  1                               l,r   : IdentList;
   36:  1                               ZList : ZeilenListe
   37:  1                            END;
   38:  0  
   39:  0  
   40:  0   VAR     wort,
   41:  0           zeile           : line;
   42:  0           MainFile,
   43:  0           InclFile        : text;
   44:  0           Options         : SET OF (Cross,LNummer,RMark,FIncl,AutoBlock,Versch);
   45:  0           MainFileName,
   46:  0           InclFileName    : STRING[14];
   47:  0           SeitenZahl,
   48:  0           SpaltenZahl,
   49:  0           ZeilenZahl,
   50:  0           ZeilenNummer,
   51:  0           PufferGroesse,
   52:  0           Iter           : integer;
   53:  0           WarteFlag,
   54:  0           KommentarFlag,
   55:  0           StringFlag,
   56:  0           IncludeFlag,
   57:  0           AutoBlockFlag,
   58:  0           ListFlag,
   59:  0           PufferVoll,
   60:  0           CaseFlag       : boolean;
   61:  0           Anfang, p, q   : PufferZeiger;
   62:  0           CrossList      : IdentList;
   63:  0  
   64:  0  {****************************************************************************}
   65:  0  {*             Erzeugung und Ausdruck der Crossreferenz-Liste               *}
   66:  0  {****************************************************************************}
   67:  0  
   68:  0  PROCEDURE NeueSeite; FORWARD;
   69:  0     {Sorgt fuer einen Seitenumbruch. Wird erst spaeter definiert}
   70:  0  
   71:  0  FUNCTION gross ( x : line) : line;
   72:  0       VAR i : linelength;
   73:  0       BEGIN FOR i:=1 TO length(x) DO x[i]:=upcase(x[i]); gross := x; END;
   74:  0  


Listing of PLIST.PAS                                               PAGE 2


   75:  0  FUNCTION Standard(VAR n : Bez) : boolean;
   76:  0    CONST Standardbezeichner : ARRAY[1..87] of Bez =
   77:  0     ('ABS','ADDR','ARCTAN','ASSIGN',
   78:  0      'BDOS','BDOSHL','BIOS','BIOSHL','BLOCKREAD','BLOCKWRITE','BOOLEAN','BYTE',
   79:  0      'CHAIN','CHR','CLOSE','CLREOL','CLRSCR','CONCAT',
   80:  0      'COPY','COS','CRTEXIT','CRTINIT',
   81:  0      'DELETE','DELAY','DELLINE','DISPOSE','EOF','EOLN','ERASE','EXECUTE',
   82:  0      'EXP','FALSE','FILEPOS','FILESIZE','FILLCHAR','FRAC','FREEMEM',
   83:  0      'GETMEM','GOTOXY','HALT','HI','HIGHVIDEO','INSERT',
   84:  0      'INSLINE','INT','INTEGER','IORESULT',
   85:  0      'KEYPRESSED','LENGTH','LN','LO','LOWVIDEO','MARK','MAXAVAIL','MEMAVAIL',
   86:  0      'MOVE','NEW','NORMVIDEO','ODD','ORD','POS','PRED','PTR',
   87:  0      'RANDOM','RANDOMIZE','READ','READLN','REAL',
   88:  0      'RELEASE','RENAME','RESET','REWRITE','ROUND',
   89:  0      'SEEK','SIN','SIZEOF','SQR','SQRT','STR','SUCC','SWAP','TRUE','TRUNC',
   90:  0      'UPCASE','VAL','WRITE','WRITELN');
   91:  0    VAR b : Bez; i,j,m : integer;
   92:  0      BEGIN b:=gross(n); i:=1; j:=87;
   93:  1            REPEAT m:=(i+j) DIV 2;
   94:  2              IF b<=Standardbezeichner[m] THEN j:=m ELSE i:=m+1
   95:  2            UNTIL i=j;
   96:  1            Standard:=(Standardbezeichner[i]=b)
   97:  1      END;
   98:  0  
   99:  0  {Die folgenden Prozeduren sind fuer die Crossreferenzliste zustaendig.
  100:  0   Dabei werden Standardprozeduren und -funktionen nicht! beruecksichtigt.}
  101:  0  
  102:  0   PROCEDURE Einfuegen(w : Bez; ln:integer); LABEL EXIT;
  103:  0     VAR gefunden : boolean; p,q : IdentList; cl,cnl : ZeilenListe;
  104:  0  
  105:  0     PROCEDURE MachZweig(VAR b : IdentList; w : Bez);
  106:  0       BEGIN
  107:  1         new(b); gefunden:=true;
  108:  1         WITH b^ DO
  109:  1           BEGIN
  110:  2            l:=NIL; r:=NIL; IName:=w;
  111:  2            new(ZList); ZList^.Nummer:=ln; ZList^.ZNext:=NIL
  112:  2           END
  113:  1       END;
  114:  0  
  115:  0     BEGIN
  116:  1       IF Standard(w) THEN GOTO EXIT;
  117:  1       gefunden:=false; q:=CrossList;
  118:  1       IF CrossList=NIL
  119:  1         THEN MachZweig(CrossList,w)
  120:  1         ELSE
  121:  1           REPEAT
  122:  2             IF gross(w)<gross(q^.IName) THEN
  123:  2                IF q^.l=NIL THEN BEGIN MachZweig(p,w); q^.l:=p END
  124:  2                            ELSE q:=q^.l
  125:  2              ELSE
  126:  2              IF gross(w)>gross(q^.IName) THEN
  127:  2                 IF q^.r=NIL THEN BEGIN MachZweig(p,w); q^.r:=p END
  128:  2                             ELSE q:=q^.r
  129:  2              ELSE WITH q^ DO BEGIN
  130:  3                gefunden:=true; cl:=ZList;
  131:  3                WHILE cl^.ZNext<>NIL DO cl:=cl^.ZNext;
  132:  3                IF cl^.Nummer<>ln THEN
  133:  3                 BEGIN
  134:  4                   new(cnl); cnl^.Nummer:=ln; cnl^.ZNext:=NIL; cl^.ZNext:=cnl
  135:  4                 END
  136:  3              END
  137:  2            UNTIL gefunden;
  138:  1        EXIT:
  139:  1     END;
  140:  0  
  141:  0   PROCEDURE SchreibListe(l : IdentList; AZ : integer);
  142:  0    VAR h : ZeilenListe; z : integer;
  143:  0    BEGIN
  144:  1      mt:=3; IF PL-ZeilenZahl-MB<8 THEN NeueSeite;
  145:  1      IF PL-ZeilenZahl-MB<5 THEN NeueSeite;
  146:  1      write(LST,'':PO,l^.IName,':':20-length(l^.IName));
  147:  1      h:=l^.ZList; z:=0;
  148:  1      WHILE h<>NIL DO
  149:  1        BEGIN
  150:  2          IF z=AZ THEN BEGIN writeln(LST); ZeilenZahl:=succ(ZeilenZahl);
  151:  3                            write(LST,'':20+PO); z:=0 END;
  152:  2          write(LST,h^.Nummer:6); h:=h^.ZNext; z:=succ(z);
  153:  2        END; writeln(LST); ZeilenZahl:=succ(ZeilenZahl)
  154:  1    END;
  155:  0  


Listing of PLIST.PAS                                               PAGE 3


  156:  0   {$A-}
  157:  0   PROCEDURE SchreibBaum(b : IdentList; AZ : integer);
  158:  0     VAR x1,xr : integer;
  159:  0     BEGIN
  160:  1       IF b<>NIL
  161:  1         THEN BEGIN
  162:  2                IF b^.l<>NIL THEN SchreibBaum(b^.l,AZ);
  163:  2                SchreibListe(b,az);
  164:  2                IF b^.r<>NIL THEN SchreibBaum(b^.r,AZ)
  165:  2              END
  166:  1     END;
  167:  0   {$A+*}
  168:  0  
  169:  0   PROCEDURE SchreibCrossListe;
  170:  0     BEGIN
  171:  1       MT:=3; IF PL-ZeilenZahl-MT<8 THEN NeueSeite;
  172:  1       writeln(LST); writeln(LST,'Crossreferenz-Liste:'); writeln(LST);
  173:  1       ZeilenZahl:=ZeilenZahl+3;
  174:  1       SchreibBaum(CrossList,(SpaltenZahl-21-PO) DIV 6)
  175:  1     END;
  176:  0  
  177:  0  {****************************************************************************}
  178:  0  {*                    Eingabe von Programmnamen und Optionen                *}
  179:  0  {****************************************************************************}
  180:  0  
  181:  0      PROCEDURE LiesFileName;
  182:  0        VAR  n : STRING[14];
  183:  0        BEGIN
  184:  1          readln(n);
  185:  1          MainFileName:=gross(n);
  186:  1          writeln
  187:  1      END;
  188:  0  
  189:  0      PROCEDURE LiesOptions;
  190:  0        VAR i : 1..6;
  191:  0            o : STRING[6];
  192:  0        BEGIN
  193:  1          writeln('L - Zeilennummern werden mitgedruckt');
  194:  1          writeln('M - Reservierte Woerter werden markiert');
  195:  1          writeln('I - Include-Files werden ausgedruckt');
  196:  1          writeln('A - Absaetze werden zusammengehalten');
  197:  1          writeln('V - druckt Verschachtelungstiefe');
  198:  1          writeln('C - generiert Crossreferenzliste');
  199:  1          writeln;
  200:  1          write('L, M, I, A, V, C, LM, LI, MI, LMI, ... LMIAVC : ');
  201:  1          readln(o);
  202:  1          Options:=[];
  203:  1          FOR i:=1 TO length(o) DO
  204:  1             CASE o[i] of
  205:  2               'L','l': Options:=Options+[LNummer];
  206:  2               'M','m': Options:=Options+[RMark];
  207:  2               'I','i': Options:=Options+[FIncl];
  208:  2               'A','a': Options:=Options+[AutoBlock];
  209:  2               'V','v': Options:=Options+[Versch];
  210:  2               'C','c': Options:=Options+[Cross];
  211:  2             END;
  212:  1          AutoBlockFlag:=AutoBlock IN Options;
  213:  1          IF Cross IN Options THEN
  214:  1            REPEAT
  215:  2             {$I-} write('Spaltenzahl : '); readln(SpaltenZahl) {$I+}
  216:  2            UNTIL IOresult=0;
  217:  1          write('Warten nach jeder Seite (J/N) ? '); readln(o);
  218:  1          WarteFlag:=(o='J') or (o='j')
  219:  1        END;
  220:  0  
  221:  0      FUNCTION FileExists( x : filetype ) : boolean;
  222:  0        {Falls das File existiert, wird es zugleich eroeffnet.}
  223:  0        BEGIN
  224:  1          CASE x OF
  225:  2            main   : BEGIN assign(MainFile,MainFileName);
  226:  3                           {$I-}; reset(MainFile); {$I+};
  227:  3                     END;
  228:  2            include: BEGIN assign(InclFile,InclFileName);
  229:  3                           {$I-}; reset(InclFile); {$I+};
  230:  3                     END;
  231:  2          END;
  232:  1          FileExists:=(IOresult=0)
  233:  1        END;
  234:  0  
  235:  0      PROCEDURE SchliessIncludeFile;
  236:  0        BEGIN
  237:  1          close(InclFile);
  238:  1          IncludeFlag:=false
  239:  1        END;
  240:  0  


Listing of PLIST.PAS                                               PAGE 4


  241:  0  {****************************************************************************}
  242:  0  {*                         Drucker-Ausgabe                                  *}
  243:  0  {****************************************************************************}
  244:  0  
  245:  0     PROCEDURE drucke ( VAR x : line );
  246:  0       VAR i : linelength;
  247:  0           a : line;
  248:  0  
  249:  0      FUNCTION reserviert ( VAR x : line ) : boolean;
  250:  0       CONST ResWords : ARRAY[1..45] of STRING[10] =
  251:  0                     ('ABSOLUTE','AND','ARRAY','BEGIN','CASE','CONST',
  252:  0                      'DIV','DO','DOWNTO','ELSE','END','END.','EXTERNAL','FILE',
  253:  0                      'FOR','FORWARD','FUNCTION','GOTO','IF','IN','INLINE',
  254:  0                      'LABEL','MOD','NIL','NOT','OF','OR','OVERLAY','PACKED',
  255:  0                      'PROCEDURE','PROGRAM','RECORD','REPEAT','SET','SHL',
  256:  0                      'SHR','STRING','THEN','TO','TYPE','UNTIL','VAR',
  257:  0                      'WHILE','WITH','XOR');
  258:  0       VAR i,j,m : 1..50; h : boolean; w : line;
  259:  0       BEGIN
  260:  1         h:=false; i:=1; j:=45; w:=gross(x);
  261:  1         IF NOT(KommentarFlag) AND NOT(StringFlag) THEN BEGIN
  262:  2           REPEAT m:=(i+j) DIV 2; IF w<=ResWords[m] THEN j:=m ELSE i:=m+1
  263:  3           UNTIL i=j; h:=(ResWords[i]=w) END;
  264:  1         reserviert:=h;
  265:  1         IF h
  266:  1          THEN IF (w='BEGIN') or (w='REPEAT')
  267:  1                 THEN Iter:=Iter+1
  268:  1                 ELSE IF (w='RECORD') THEN
  269:  1                      BEGIN CaseFlag:=false; Iter:=Iter+1 END
  270:  1                 ELSE IF (w='CASE') AND CaseFlag THEN Iter:=Iter+1
  271:  1                 ELSE IF (w='END') OR (w='UNTIL') OR (w='END.') THEN
  272:  1                      BEGIN CaseFlag:=true; Iter:=Iter-1 END
  273:  1  
  274:  1       END;
  275:  0  
  276:  0      PROCEDURE markiere (VAR x : line );
  277:  0       {Hier koennen die gewuenschten Sequenzen zum Markieren der
  278:  0        reservierten Woerter eingesetzt werden. Hier ein Beispiel
  279:  0        fuer Typenrad-Drucker: Gross und vierfach.}
  280:  0       VAR i,j : Byte;
  281:  0       BEGIN
  282:  1         IF RMark IN Options
  283:  1          THEN BEGIN
  284:  2            FOR i:=1 TO 3 DO
  285:  2              BEGIN
  286:  3                write(LST,gross(x)); FOR j:=1 TO length(x) DO write(LST,#8)
  287:  3              END;
  288:  2              write(LST,gross(x))
  289:  2            END
  290:  1          ELSE write(LST,x)
  291:  1       END;
  292:  0  


Listing of PLIST.PAS                                               PAGE 5


  293:  0      BEGIN {drucke}
  294:  1         write(LST,'':PO);
  295:  1         IF LNummer IN Options THEN write(LST,ZeilenNummer:5,': ');
  296:  1         IF Versch  IN Options THEN write(LST,Iter:2,'  ');
  297:  1          a:=''; i:=1;
  298:  1          WHILE i<=length(x) DO
  299:  1             BEGIN
  300:  2               IF x[i] IN ['^','A'..'Z','a'..'z'] THEN
  301:  2                   BEGIN a:=x[i]; i:=succ(i);
  302:  3                     WHILE (x[i] IN ['.','^','0'..'9','A'..'Z','a'..'z','_'])
  303:  3                           AND (i<=length(x)) DO
  304:  3                             BEGIN a:=a+x[i]; i:=succ(i) END
  305:  3                     END
  306:  2                  ELSE BEGIN
  307:  3                         IF a<>'' THEN
  308:  3                           IF reserviert(a) THEN markiere(a)
  309:  3                                            ELSE BEGIN write(LST,a);
  310:  4                                            IF Cross IN Options THEN
  311:  4                                             IF NOT KommentarFlag THEN
  312:  4                                               IF NOT StringFlag
  313:  4                                                 THEN Einfuegen(a,ZeilenNummer)
  314:  4                                             END;
  315:  3                         a:='';
  316:  3                         write(LST,x[i]);
  317:  3                         IF NOT(StringFlag) AND ((x[i]='{') OR ((x[i]='(')
  318:  3                            AND (x[i+1]='*'))) THEN KommentarFlag:=true;
  319:  3                         IF NOT(StringFlag) AND((x[i]='}') OR ((x[i]='*')
  320:  3                            AND (x[i+1]=')'))) THEN KommentarFlag:=false;
  321:  3                         IF NOT(KommentarFlag) AND(x[i]=chr(39))
  322:  3                            THEN StringFlag:=NOT(StringFlag); i:=succ(i)
  323:  3                  END
  324:  2             END;
  325:  1             IF a<>'' THEN IF reserviert(a)
  326:  1                THEN markiere(a) ELSE
  327:  1                BEGIN write(LST,a);
  328:  2                  IF NOT(KommentarFlag OR StringFlag) AND (Cross IN Options)
  329:  2                   THEN Einfuegen(a,ZeilenNummer) END;
  330:  1             writeln(LST); StringFlag:=false
  331:  1      END;
  332:  0  
  333:  0     PROCEDURE SeitenKopf;
  334:  0       VAR i : linelength;
  335:  0       BEGIN
  336:  1        IF ListFlag THEN BEGIN
  337:  2         writeln(LST); write(LST,'':PO);
  338:  2         FOR i:=1 TO length(HE) DO IF HE[i]='#' THEN write(LST,SeitenZahl)
  339:  2                                                ELSE write(LST,HE[i]);
  340:  2         writeln(LST);
  341:  2         FOR i:=1 TO MT DO writeln(LST);
  342:  2         ZeilenZahl:=MT+3
  343:  2        END
  344:  1       END;
  345:  0  
  346:  0     PROCEDURE NeueSeite;
  347:  0       VAR i : linelength;
  348:  0       BEGIN
  349:  1        PufferGroesse:=0;
  350:  1        IF ListFlag THEN BEGIN write(LST,'':PO);
  351:  2         FOR i:=ZeilenZahl TO PL-3 DO writeln(LST);
  352:  2         FOR i:=1 TO length(FO) DO IF FO[i]='#' THEN write(LST,SeitenZahl)
  353:  2                                                ELSE write(LST,FO[i]);
  354:  2         FOR i:=1 TO 3 DO writeln(LST);
  355:  2         SeitenZahl:=SeitenZahl+1;
  356:  2         IF WarteFlag THEN BEGIN write('Weiter mit RETURN'); readln END;
  357:  2         SeitenKopf
  358:  2        END {if ListFlag}
  359:  1       END;
  360:  0  
  361:  0  {****************************************************************************}
  362:  0  {*            Bearbeitung von Punkt- und Compiler-Anweisungen               *}
  363:  0  {****************************************************************************}
  364:  0  
  365:  0     FUNCTION Sonder( VAR x : line ) : boolean;
  366:  0        BEGIN
  367:  1          Sonder:=(pos(chr(39),x)=0) AND ((pos('{.',x)>0) OR (pos('(*.',x)>0) OR
  368:  1             ((FIncl IN Options) AND ((pos('{$I',x)>0) OR (pos('(*$I',x)>0))
  369:  1              AND (pos('{$I+',x)=0) AND (pos('{$I-',x)=0)
  370:  1              AND (pos('(*$I+',x)=0) AND (pos('(*$I-',x)=0)))
  371:  1    END;
  372:  0  


Listing of PLIST.PAS                                               PAGE 6


  373:  0    FUNCTION SonderZeile ( VAR x : line ) : boolean;
  374:  0      {In Sonderzeilen duerfen keine einfachen Anfuehrungszeichen sein!}
  375:  0      VAR h   : boolean;
  376:  0          w   : STRING[2];
  377:  0          z   : STRING[3];
  378:  0          Fehler,
  379:  0          i,j,m  : integer;
  380:  0      BEGIN
  381:  1        h:=Sonder(x);
  382:  1        IF h THEN BEGIN
  383:  2          i:=pos('{.',x) OR pos('(*.',x);
  384:  2          IF i>0 THEN IF pos('(*.',x)=i THEN m:=1 ELSE m:=0;
  385:  2          IF i>0 THEN
  386:  2            REPEAT w:=''; Fehler:=0;
  387:  3              IF x[i] IN ['A'..'Z','a'..'z'] THEN BEGIN
  388:  4                w:=x[i]+x[i+1]; i:=i+2;
  389:  4                IF (w='PL') OR (w='MT') OR (w='MB') OR (w='PO') OR (w='CP')
  390:  4                 THEN BEGIN
  391:  5                   z:='';
  392:  5                   WHILE NOT(x[i] IN ['0'..'9']) DO i:=i+1;
  393:  5                   WHILE x[i] IN ['0'..'9'] DO BEGIN z:=z+x[i]; i:=i+1 END;
  394:  5                   IF w='PL' THEN val(z,PL,Fehler);
  395:  5                   IF w='MT' THEN val(z,MT,Fehler);
  396:  5                   IF w='MB' THEN val(z,MB,Fehler);
  397:  5                   IF w='PO' THEN val(z,PO,Fehler);
  398:  5                   IF w='CP' THEN val(z,CP,Fehler);
  399:  5                END; h:=Fehler=0;
  400:  4                IF w='HE' THEN BEGIN HE:=copy(x,i,length(x)-i-m); i:=127 END;
  401:  4                IF w='FO' THEN BEGIN FO:=copy(x,i,length(x)-i-m); i:=127 END;
  402:  4                IF w='PA' THEN NeueSeite;
  403:  4                IF w='CP' THEN IF PL-MT-MB-ZeilenZahl<CP THEN NeueSeite;
  404:  4                IF w='L+' THEN ListFlag:=true;
  405:  4                IF w='L-' THEN ListFlag:=false;
  406:  4                IF w='A+' THEN AutoBlockFlag:=true;
  407:  4                IF w='A-' THEN AutoBlockFlag:=false
  408:  4              END;
  409:  3              i:=i+1;
  410:  3            UNTIL i>length(x)
  411:  2           ELSE BEGIN
  412:  3             i:=pos('{$I',x)+2; IF i=2 THEN i:=pos('(*$I',x)+3;
  413:  3            InclFileName:='';
  414:  3            WHILE (i<length(x)) AND (length(InclFileName)<12) DO BEGIN
  415:  4               i:=i+1;
  416:  4               IF x[i] in['-','.',':','0'..'9','a'..'z','A'..'Z']
  417:  4                 THEN InclFileName:=InclFileName+gross(x[i])
  418:  4            END;
  419:  3            IF MainFileName[2]=':' THEN
  420:  3              IF InclFileName[2]=':' THEN InclFileName[1]:=MainFileName[1]
  421:  3                        ELSE InclFileName:=MainFileName[1]+':'+InclFileName;
  422:  3            IncludeFlag:=FileExists(Include); h:=IncludeFlag;
  423:  3            IF IncludeFlag THEN writeln('Including ',InclFileName)
  424:  3                           ELSE writeln('File ',InclFileName,' nicht gefunden,');
  425:  3          END;
  426:  2       END;
  427:  1       SonderZeile:=h
  428:  1     END;
  429:  0  
  430:  0  {****************************************************************************}
  431:  0  {*                    Puffer-Operationen mit FIFO                           *}
  432:  0  {****************************************************************************}
  433:  0  
  434:  0     FUNCTION leer(VAR x : line) : boolean;
  435:  0       VAR h : boolean;
  436:  0           i : integer;
  437:  0       BEGIN
  438:  1         h:=true;
  439:  1         i:=1;
  440:  1         WHILE h AND (i<=length(x)) DO BEGIN h:=ord(x[i])=32; i:=i+1 END;
  441:  1         leer:=h
  442:  1       END;
  443:  0  
  444:  0   FUNCTION EndOfBlock : boolean;
  445:  0     VAR h : boolean;
  446:  0     BEGIN
  447:  1       h:=EOF(MainFile);
  448:  1       IF IncludeFlag THEN IF EOF(InclFile) THEN BEGIN h:=true;
  449:  2                                                       IncludeFlag:=false;
  450:  2                                                       SchliessIncludeFile
  451:  2                                                 END;
  452:  1       IF NOT(h) THEN h:=leer(zeile);
  453:  1       IF NOT(h) THEN h:=Sonder(zeile);
  454:  1       IF PufferGroesse>PL-MT-MB-3 THEN h:=true;
  455:  1       EndOfBlock:=h
  456:  1     END;
  457:  0  


Listing of PLIST.PAS                                               PAGE 7


  458:  0     PROCEDURE ClearPuffer;
  459:  0       BEGIN
  460:  1         p:=Anfang;
  461:  1         WHILE p^.Naechster<>NIL DO BEGIN
  462:  2            q:=p; dispose(p); p:=q^.Naechster;
  463:  2         END; dispose(p);
  464:  1         PufferVoll:=false
  465:  1       END;
  466:  0  
  467:  0   PROCEDURE LiesPuffer;
  468:  0     BEGIN PufferGroesse:=0;
  469:  1       new(q); Anfang:=q; q^.Naechster:=NIL;
  470:  1       REPEAT
  471:  2         IF IncludeFlag THEN readln(InclFile,zeile)
  472:  2                        ELSE readln(MainFile,zeile);
  473:  2         q^.Eintrag:=zeile;
  474:  2         PufferGroesse:=PufferGroesse+1;
  475:  2         new(p);
  476:  2         q^.Naechster:=p;
  477:  2         p^.Naechster:=NIL;
  478:  2         q:=p;
  479:  2       UNTIL EndOfBlock;
  480:  1       PufferVoll:=true
  481:  1     END;
  482:  0  


Listing of PLIST.PAS                                               PAGE 8


  483:  0  {****************************************************************************}
  484:  0  {*                             Hauptprogramm                                *}
  485:  0  {****************************************************************************}
  486:  0  
  487:  0  BEGIN {Hauptprogramm}
  488:  1  
  489:  1    IncludeFlag:=false;                    ListFlag:=true;
  490:  1    SeitenZahl:=1;                         StringFlag:=false;
  491:  1    KommentarFlag:=false;                  PufferVoll:=false;
  492:  1    CaseFlag:=true;                        Iter:=0;
  493:  1    ClrScr; writeln('PLIST Vers. 3.6'); writeln;
  494:  1  
  495:  1    REPEAT
  496:  2      write('Geben Sie den Programm-Namen ein oder ? oder RETURN fuer Ende: ');
  497:  2      LiesFileName;
  498:  2  
  499:  2      IF MainFileName='?' THEN BEGIN
  500:  3        ClrScr;
  501:  3        writeln('Um den Ausdruck des Programms zu formatieren, koennen Sie');
  502:  3        writeln('folgende Punktkommandos benuetzen: (Syntax : {.Kommando})');
  503:  3        writeln;
  504:  3        writeln('Kommando  Wirkung                       Voreinstellung');
  505:  3        writeln;
  506:  3        writeln('PL nn     Seitenlaenge                        ',PL);
  507:  3        writeln('MT nn     Rand oben                           ',MT);
  508:  3        writeln('MB nn     Rand unten                          ',MB);
  509:  3        writeln('PO nn     Rand links                          ',PO);
  510:  3        writeln('CP nn     Neue Seite bei weniger als n Zeilen ',CP);
  511:  3        writeln('PA        Neue Seite');
  512:  3        writeln('HE        Kopfzeile          Lising von ...   Seite #');
  513:  3        writeln('FO        Fusszeile                          (keine)');
  514:  3        writeln('L+/L-     Listing   ein/aus');
  515:  3        writeln('A+/A-     Autoblock ein/aus');
  516:  3        writeln;
  517:  3        writeln('Alle Kommandos ausser HE und FO koennen auch in eine Zeile');
  518:  3        writeln('geschrieben werden. Beispiel {.PL 64, MT 8, PO 5}');
  519:  3        writeln('In HE und FO kann # fuer die Seitennummer angegeben werden.');
  520:  3        writeln
  521:  3       END
  522:  2  
  523:  2       ELSE IF (MainFileName<>'') AND FileExists(main) THEN BEGIN
  524:  3        LiesOptions; CrossList:=NIL; SeitenZahl:=1;
  525:  3        writeln('Listing of ',MainFileName,'.');
  526:  3        HE:='Listing of '+MainFileName
  527:  3            +'                                               PAGE #';
  528:  3        ZeilenZahl:=0;
  529:  3        ZeilenNummer:=1;
  530:  3        WHILE NOT(EOF(MainFile)) OR PufferVoll DO BEGIN
  531:  4           IF NOT PufferVoll THEN BEGIN LiesPuffer; p:=Anfang END;
  532:  4           zeile:=p^.Eintrag; p:=p^.Naechster;
  533:  4           IF p^.Naechster=NIL THEN ClearPuffer;
  534:  4           IF AutoBlockFlag AND (PufferGroesse>PL-ZeilenZahl-MB-3)
  535:  4              AND (PufferGroesse<=PL-MT-MB-3) THEN NeueSeite;
  536:  4           PufferGroesse:=0;
  537:  4           IF NOT SonderZeile(zeile) THEN BEGIN
  538:  5            IF ZeilenZahl mod PL = 0 THEN SeitenKopf;
  539:  5            IF PL - ZeilenZahl   = MB + 3 THEN NeueSeite;
  540:  5            IF ListFlag THEN BEGIN drucke(zeile); ZeilenZahl:=ZeilenZahl+1 END;
  541:  5            ZeilenNummer:=ZeilenNummer+1;
  542:  5           END {if not SonderZeile}
  543:  4        END; {while} IF cross IN Options THEN SchreibCrossListe;
  544:  3        close(MainFile);
  545:  3       END
  546:  2  
  547:  2      ELSE IF MainFileName<>'' THEN writeln('File existiert nicht.')
  548:  2  
  549:  2    UNTIL MainFileName='';
  550:  1  END.