home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 12 / praxis / doku.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-09-18  |  10.1 KB  |  397 lines
  1. (*-------------------------------------------------------*)
  2. (*                       DOKU.PAS                        *)
  3. (*     Dokumentation von Prozeduren und Funktionen in    *)
  4. (*                 Turbo-Pascal-Units                    *)
  5. (*            (c) 1990 B. Biever & TOOLBOX               *)
  6. (*-------------------------------------------------------*)
  7.  
  8. PROGRAM Unitdokumentation;
  9.  
  10. USES Crt, Dos, Printer;
  11.  
  12. TYPE
  13.   DefZeiger = ^DefZeile;
  14.   DefZeile  = RECORD
  15.                 Zeile     : STRING[79];
  16.                 Naechstes : DefZeiger;
  17.               END;
  18. CONST
  19.   Ign : BOOLEAN     = FALSE;
  20.   chk : 0..3        = 0;
  21.  
  22. VAR
  23.   Textdatei         : Text;
  24.   FPath             : DirStr;
  25.   FName             : NameStr;
  26.   FExt              : ExtStr;
  27.   FileName          : PathStr;
  28.   UnitName          : STRING[20];
  29.   ProcedureName     : STRING[40];
  30.   AnzahlProzeduren  : INTEGER;
  31.   Wurzel, Pl, Ptemp : DefZeiger;
  32.  
  33. {---------------------------------------}
  34.  
  35. FUNCTION UpString(s: STRING) : STRING;
  36. VAR
  37.   i : BYTE;
  38. BEGIN
  39.   FOR i := 1 TO Length(s) DO s[i] := UpCase(s[i]);
  40.   UpString := s;
  41. END;
  42.  
  43. {---------------------------------------}
  44.  
  45. PROCEDURE Init;
  46. { Initialisieren  aller Variablen,      }
  47. { Dateinamen einlesen, Dateien eröffnen }
  48. VAR
  49.   FileNameDir : DirStr;
  50.   FileNameName: NameStr;
  51.   FileNameExt : ExtStr;
  52. BEGIN
  53.   New(Wurzel);
  54.   Pl := Wurzel;
  55.   UnitName := '';
  56.   AnzahlProzeduren := 0;
  57.   ClrScr;
  58.   Write('Bitte geben Sie den Dateinamen ein: ');
  59.   ReadLn(FileName);
  60.   FileName := UpString(FileName);
  61.   FSplit(FileName, FileNameDir, FileNameName, FileNameExt);
  62.   IF FileNameExt = '' THEN
  63.     FileName := Concat(FileName, '.PAS');
  64.   WriteLn;
  65.   Assign(Textdatei, FileName);
  66.   {$I-}
  67.   Reset(Textdatei);
  68.   {$I+}
  69.   IF IOResult <> 0 THEN BEGIN
  70.     TextColor(LightRed);
  71.     WriteLn('Fehler: Datei ', FileName);
  72.     WriteLn('nicht gefunden. Programm beendet.');
  73.     Halt;
  74.   END;
  75. END;
  76.  
  77. {---------------------------------------}
  78.  
  79. FUNCTION Find(SubStr, s: STRING) : BYTE;
  80. { Suchen des Schlüsselwortes unter Be- }
  81. { rücksichtigung von verschachtelten   }
  82. { Kommentaren, Hochkommas und Teil-    }
  83. { strings.                                                                                        }
  84. VAR
  85.   SubStrLaenge,
  86.   i, j         : BYTE;
  87.   a            : STRING;
  88.   test         : BOOLEAN;
  89.  
  90.   PROCEDURE FindRem(Position: BYTE);
  91.   VAR
  92.     a1, a2 : CHAR;
  93.   BEGIN
  94.     a1 := s[Position];
  95.     IF (a1 = '{') AND (chk = 0) THEN BEGIN
  96.       Ign := TRUE; chk := 1;      { Kommentar      }
  97.     END
  98.     ELSE IF (a1 = '}') AND (chk = 1) THEN BEGIN
  99.       Ign := FALSE; chk := 0      { Ende Kommentar }
  100.     END
  101.     ELSE IF (a1 = '''') AND (chk = 0) THEN BEGIN
  102.       Ign := TRUE; chk := 3;      { '-Anfang }
  103.     END
  104.     ELSE IF (a1 = '''') AND (chk = 3) THEN BEGIN
  105.       Ign := FALSE; chk := 0;     { -Ende    }
  106.     END
  107.     ELSE IF Position + 1 <= Length(s) THEN BEGIN
  108.       IF (a1 = '(') AND (chk = 0) THEN BEGIN
  109.         a2 := s[Position + 1];
  110.         IF a2 = '*' THEN BEGIN
  111.           Ign := TRUE; chk := 2;  { Kommentar      }
  112.         END;
  113.       END
  114.       ELSE IF a1 = '*' THEN BEGIN
  115.         a2 := s[Position + 1];
  116.         IF (a2 = ')') AND (chk = 2) THEN BEGIN
  117.           Ign := FALSE; chk := 0; { Ende Kommentar }
  118.         END;
  119.       END;
  120.     END;
  121.   END;
  122.  
  123. BEGIN
  124.   Find := 0;
  125.   test := FALSE;
  126.   s := UpString(s);
  127.   SubStr := UpString(SubStr);
  128.   SubStrLaenge := Length(SubStr);
  129.   IF Length(SubStr) > Length(s) THEN Exit;
  130.   IF (Length(s) - SubStrLaenge) >= 0 THEN
  131.   BEGIN
  132.     FOR i:= 1 TO Length(s) DO BEGIN
  133.       FindRem(i);
  134.       a := Copy(s, i, SubStrLaenge);
  135.       IF a = SubStr THEN BEGIN
  136.         IF i > 1 THEN
  137.           IF s[i - 1] <> ' ' THEN BEGIN
  138.             find := 0; Exit;
  139.           END;
  140.         IF i + SubStrLaenge < Length(s) THEN
  141.           IF i > 1 THEN
  142.             IF NOT (s[i + SubStrLaenge + 1] IN [' ', '('])
  143.             THEN BEGIN
  144.               find := 0; Exit;
  145.             END;
  146.         IF ign THEN find := 0 ELSE find := i;
  147.       END;
  148.     END;
  149.   END;
  150. END;
  151.  
  152. {---------------------------------------}
  153.  
  154. PROCEDURE UnitNameSuchen;
  155. { Sucht das reservierte Wort Unit und schreibt }
  156. { den Namen der Unit in die Variable UnitName. }
  157. VAR
  158.   s        : STRING[150];
  159.   Position,
  160.   i        : BYTE;
  161. BEGIN
  162.   s := ''; i := 0;
  163.   REPEAT
  164.     ReadLn(Textdatei, s);
  165.     Position := Find('UNIT', s);
  166.   UNTIL EoF(Textdatei) OR ((Position > 0) AND (chk = 0));
  167.   IF EoF(Textdatei) THEN BEGIN
  168.     TextColor(LightRed);
  169.     WriteLn('Fehler: Keine UNIT-Anweisung');
  170.     WriteLn('gefunden. Programm beendet.');
  171.     Halt;
  172.   END;
  173.   REPEAT
  174.     Inc(i);
  175.     IF s[i + Position + 4] <> ' ' THEN
  176.       UnitName := Concat(UnitName, s[i + 4]);
  177.   UNTIL (s[i + Position + 4] = ';')
  178.      OR (s[i + Position + 4] = '  ');
  179. END;
  180.  
  181. {---------------------------------------}
  182.  
  183. PROCEDURE ProzedurenSuchen;
  184. { Sucht alle Inferface-Prozeduren }
  185. VAR
  186.   i1, Pos,
  187.   p1, p2, p3,
  188.   WortLaenge : BYTE;
  189.   TempIgn1,
  190.   TempIgn2   : BOOLEAN;
  191.   s,
  192.   TempLinie  : STRING;
  193.   a          : CHAR;
  194. BEGIN
  195.   REPEAT
  196.     ReadLn(Textdatei, s);
  197.     Pos := Find('INTERFACE', s);
  198.   UNTIL EoF(Textdatei) OR (Pos <> 0);
  199.   IF EoF(Textdatei) THEN BEGIN
  200.     TextColor(LightRed);
  201.     WriteLn('Fehler: Keine INTERFACE-Anweisung');
  202.     WriteLn('gefunden. Programm beendet.');
  203.     Halt;
  204.   END;
  205.   REPEAT
  206.     ProcedureName := '';
  207.     ReadLn(Textdatei, s);
  208.     TempIgn1 := Ign;
  209.     TempIgn2 := Ign;
  210.     p2 := Find('IMPLEMENTATION', s);
  211.     IF p2 = 0 THEN BEGIN
  212.       p1 := Find('PROCEDURE', s);
  213.       TempIgn1 := Ign;
  214.       p3 := Find('FUNCTION', s);
  215.       TempIgn2 := Ign;
  216.       IF (p1 > 0) OR (p3 > 0) THEN BEGIN
  217.         IF p1 > 0 THEN BEGIN
  218.           Pos := p1; WortLaenge := 9;
  219.         END
  220.         ELSE
  221.         BEGIN
  222.           Pos := p3; WortLaenge := 8;
  223.         END;
  224.         IF (s[Pos + WortLaenge] <> ';') AND
  225.            (s[Pos + WortLaenge] <> '(') THEN BEGIN
  226.           Pl^.Zeile := 'NEUEPROZEDUR';
  227.           New(Ptemp);
  228.           Pl^.Naechstes := Ptemp;
  229.           Pl := Ptemp;
  230.           i1 := 0;
  231.           Inc(i1);
  232.           a := s[i1 + Pos + WortLaenge];
  233.           WHILE (a <> ';') AND (a <> '(') AND
  234.                 (a <> '  ') AND (a <> ':') DO
  235.                  BEGIN
  236.             Inc(i1);
  237.             ProcedureName := Concat(ProcedureName, a);
  238.             a := s[i1 + Pos + WortLaenge];
  239.           END;
  240.           Inc(AnzahlProzeduren);
  241.           TempLinie := Concat(ProcedureName,
  242.             '                        '); {24 Leerzeichen}
  243.           Insert(UnitName, TempLinie, 24);
  244.           Pl^.Zeile := TempLinie;
  245.           New(Ptemp);
  246.           Pl^.Naechstes := Ptemp;
  247.           Pl := Ptemp;
  248.           FSplit(FileName, FPath, FName, FExt);
  249.           FName := UpString(FName);
  250.           FExt := UpString(FExt);
  251.           TempLinie := Concat('Unit-Dateiname: ',
  252.                               FName, FExt);
  253.           Pl^.Zeile := TempLinie;
  254.           New(Ptemp);
  255.           Pl^.Naechstes := Ptemp;
  256.           Pl := Ptemp;
  257.         END;
  258.       END;
  259.       IF AnzahlProzeduren <> 0 THEN BEGIN
  260.         Pl^.Zeile := s;
  261.         New(Ptemp);
  262.         Pl^.Naechstes := Ptemp;
  263.         Pl := Ptemp;
  264.       END;
  265.       GotoXY(1, 6);
  266.       Write('Anzahl Prozeduren: ', AnzahlProzeduren);
  267.     END;
  268.   UNTIL EoF(Textdatei) OR (p2 <> 0);
  269.   Pl^.Zeile := '';
  270.   Pl^.Naechstes := NIL;
  271.   Ptemp := Wurzel;
  272. END;
  273.  
  274. {---------------------------------------}
  275.  
  276. PROCEDURE Ausdrucken;
  277. { Ausgabe für einen Epson LQ-1050 }
  278. VAR
  279.   Seite   : LONGINT;
  280.   zz      : WORD;
  281.   s       : STRING[3];
  282.   Pointer : DefZeiger;
  283. TYPE
  284.   Zustand = (ein, aus);
  285.  
  286.   PROCEDURE Breitschrift(einaus: Zustand);
  287.   BEGIN
  288.     IF einaus = ein THEN
  289.       Write(Lst, Chr(27), Chr(87), Chr(1))
  290.     ELSE
  291.       Write(Lst, Chr(27), Chr(87), Chr(0));
  292.   END;
  293.  
  294.   PROCEDURE Doppeldruck(einaus: Zustand);
  295.   BEGIN
  296.     IF einaus = ein THEN
  297.       Write(Lst, Chr(27), Chr(71))
  298.     ELSE
  299.       Write(Lst, Chr(27), Chr(72));
  300.   END;
  301.  
  302.   PROCEDURE Doppeltehoehe(einaus: Zustand);
  303.   BEGIN
  304.    IF einaus = ein THEN
  305.      Write(Lst, Chr(27), Chr(119), Chr(1))
  306.    ELSE
  307.      Write(Lst, Chr(27), Chr(119), Chr(0));
  308.   END;
  309.  
  310.   PROCEDURE Formfeed;
  311.   BEGIN
  312.     Write(Lst, Chr(12));
  313.   END;
  314.  
  315.   PROCEDURE Titelblatt;
  316.   VAR
  317.    i         : INTEGER;
  318.    Titelzeile: STRING[40];
  319.   BEGIN
  320.     FOR i:= 1 TO 72 DO Write(Lst, Chr(196));
  321.     WriteLn(Lst); WriteLn(Lst);
  322.     Doppeltehoehe(ein); Breitschrift(ein);
  323.     Titelzeile := '           Toolbox-Tool';
  324.     WriteLn(Lst, Titelzeile);
  325.     Breitschrift(aus); Doppeltehoehe(aus);
  326.     FOR i:= 1 TO 72 DO Write(Lst, Chr(196));
  327.     WriteLn(Lst);
  328.     zz := 6;
  329.   END;
  330.  
  331.   PROCEDURE Blattende;
  332.   VAR
  333.     i          : BYTE;
  334.     Titelzeile : STRING[80];
  335.     s          : STRING[3];
  336.   BEGIN
  337.     FOR i:= 4 TO (71 - zz) DO WriteLn(Lst);
  338.     Inc(Seite);
  339.     FOR i:= 1 TO 72 DO Write(Lst, Chr(196));
  340.     WriteLn(Lst);
  341.     Doppeltehoehe(ein);
  342.     Str(Seite, s);
  343.     Titelzeile := '                             '
  344.     {29 Leerz.} + ' --- Seite ' + s  + ' ---';
  345.     WriteLn(Lst, Titelzeile);
  346.     Doppeltehoehe(aus);
  347.     FOR i:= 1 TO 72 DO Write(Lst, Chr(196));
  348.     WriteLn(Lst);
  349.     zz := 0;
  350.     Formfeed;
  351.   END;
  352.  
  353.   PROCEDURE Titel;
  354.   VAR
  355.     i          : BYTE;
  356.     Titelzeile : STRING[40];
  357.   BEGIN
  358.     FOR i:= 1 TO 72 DO Write(Lst, Chr(196));
  359.     WriteLn(Lst); WriteLn(Lst);
  360.     Pointer := Pointer^.Naechstes;
  361.     Doppeltehoehe(ein); Breitschrift(ein);
  362.     Titelzeile := Pointer^.Zeile;
  363.     Write(Lst, Titelzeile);
  364.     Doppeltehoehe(aus); Breitschrift(aus);
  365.     Pointer := Pointer^.Naechstes;
  366.     WriteLn(Lst);
  367.     FOR i:= 1 TO 72 DO Write(Lst, Chr(196));
  368.     WriteLn(Lst); WriteLn(Lst);
  369.     zz := zz + 6;
  370.   END;
  371.  
  372. BEGIN
  373.   Doppeldruck(ein);
  374.   Seite := 0; zz := 0;
  375.   Pointer := Wurzel;
  376.   REPEAT
  377.     Titelblatt;
  378.     REPEAT
  379.       IF Pointer^.Zeile = 'NEUEPROZEDUR' THEN Titel;
  380.       WriteLn(Lst, Pointer^.Zeile);
  381.       Pointer := Pointer^.Naechstes;
  382.       Inc(zz);
  383.     UNTIL (zz >= 65) OR (Pointer = NIL);
  384.     Blattende;
  385.   UNTIL Pointer = NIL;
  386. END;
  387.  
  388. {---------------------------------------}
  389.  
  390. BEGIN
  391.   Init;
  392.   UnitNameSuchen;
  393.   ProzedurenSuchen;
  394.   Close(Textdatei);
  395.   Ausdrucken;
  396. END.
  397.