home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / turbopas / tlist11.lbr / MAIN.PQS / main.pas
Encoding:
Pascal/Delphi Source File  |  1985-11-08  |  5.6 KB  |  176 lines
  1. FUNCTION User_ConIn : CHAR;
  2. {
  3. User-defined Console-In driver function.  Allows us to trap Console-in bytes
  4. so that user interrupts can be supported.  When TLIST is used to output
  5. to disk files, TURBO's "KEYPRESSED" function works fine to detect when a key
  6. has been pressed; it can then be read to see if it was a ^C.  However, when
  7. output is to the printer, this does not work (ask Borland, I don't know).
  8. Use of TURBO's direct BIOS handlers is to no avail also (which makes sense
  9. since KEYPRESSED makes use of the same routines).  The compiler switch $U+
  10. doesn't seem to work either.  Therefore, console input is buffered here with
  11. a global abort switch set whenever ^C is seen.
  12. }
  13.  
  14. VAR
  15.  I : INTEGER;
  16.  
  17. BEGIN
  18.  I := 0;
  19.  WHILE I = 0 DO I := BDOS(6,255);      {BDOS procedure for Direct Console I/O}
  20.  IF I = 3 THEN Abort := TRUE;
  21.  User_ConIn := CHR(I);
  22. END;
  23.  
  24. BEGIN                       {Main program}
  25.  DiskFile := FALSE;
  26.  Paginate := FALSE;
  27.  Starting_page_number := 1;
  28.  IF PARAMCOUNT = 0 THEN
  29.   BEGIN
  30.    CLRSCR;
  31.    WRITELN(Header);
  32.    WRITELN;
  33.    WRITELN('  This lists TURBO* Pascal files to CP/M''s LST: device [L]');
  34.    WRITELN('  or to default disk [D], with paper change pauses [P] and');
  35.    WRITELN('  from starting page number [##].  Arbitrary option order;');
  36.    WRITELN('  last option controls.   Defaults are LST:, no Pause, and');
  37.    WRITELN('  Page 1 start.      "TLIST filename.ext [d] [l] [p] [##]"');
  38.    WRITELN;
  39.    WRITELN('  e.g. TLIST FILENAME.EXT D P 12    (disk, pause, page 12)');
  40.    WRITELN('       TLIST FILENAME.EXT 5 P L      (LST:, pause, page 5)');
  41.    WRITELN('       TLIST FILENAME.EXT         (LST:, no pause, page 1)');
  42.    WRITELN('       TLIST FILENAME.EXT L 2     (LST:, no pause, page 2)');
  43.    WRITELN('       TLIST FILENAME.EXT L P D P (disk, no pause, page 1)');
  44.    WRITELN;
  45.    WRITELN('  *Registered Trademark of Borland International.');
  46.    WRITELN;
  47.    WRITELN;
  48.    WRITE('Filename and print options (separated by spaces)? ');
  49.    READLN(CmdLine);         {Place into CP/M's command line buffer.}
  50.    WRITELN;
  51.   END
  52.  ELSE
  53.   BEGIN
  54.    WRITELN;
  55.    WRITELN(Header);
  56.    WRITELN;
  57.   END;
  58.  Header := PARAMSTR(1);
  59.  FOR I := 2 TO PARAMCOUNT DO   {Not executed if no parameters given.}
  60.   BEGIN
  61.    Ch := COPY(PARAMSTR(I), 1, 1);
  62.    IF Ch IN ['L', 'l'] THEN DiskFile := FALSE;
  63.    IF Ch IN ['D', 'd'] THEN DiskFile := TRUE;
  64.    IF Ch IN ['P', 'p'] THEN Paginate := NOT Paginate;
  65.    VAL(PARAMSTR(I), Count, Dummy);
  66.    IF Dummy = 0 THEN Starting_page_number := Count;
  67.   END;
  68.  FOR I := 1 TO LENGTH(Header) DO
  69.   Header[I] := UPCASE(Header[I]);
  70.  ASSIGN(Text_File, Header);
  71.  {$I-}
  72.  RESET(Text_File);
  73.  {$I+}
  74.  IF IORESULT <> 0 THEN
  75.   WRITELN('Cannot find ', Header)
  76.  ELSE
  77.   BEGIN
  78.    I := POS('.', Header);
  79.    IF DiskFile THEN
  80.     BEGIN
  81.      IF I <> 0 THEN
  82.       ASSIGN(List_file, COPY(Header, 1, I - 1) + '.PRN')
  83.      ELSE
  84.       ASSIGN(List_file, Header + '.PRN');
  85.      REWRITE(List_file);
  86.     END;
  87.    Set_up_hash_tables;
  88.    Comment := FALSE;
  89.    Strng := FALSE;
  90.    Header := CONCAT('Listing of ', Header, ', ', Header_String);
  91.    Line_number := 0;
  92.    LineCount := 0;
  93.    Page_number := 1;
  94.    Max_no_lines := Page_Length - Margin_Top - Margin_Bottom;
  95.    IF Page_number >= Starting_page_number THEN
  96.     IF DiskFile THEN
  97.      BEGIN
  98.       FOR I := 1 TO Margin_Top - Header_Margin - 1 DO WRITELN(List_file);
  99.       WRITELN(List_file, Header:(LENGTH(Header) + Page_Offset), ^M,
  100.        'Page':(Line_Width + Page_Offset - 4), Page_number:4);
  101.       FOR I := 1 TO Header_Margin DO WRITELN(List_file);
  102.      END
  103.     ELSE
  104.      BEGIN
  105.       FOR I := 1 TO Margin_Top - Header_Margin - 1 DO WRITELN(LST);
  106.       WRITELN(LST, Header:(LENGTH(Header) + Page_Offset), ^M,
  107.        'Page':(Line_Width + Page_Offset - 4), Page_number:4);
  108.       FOR I := 1 TO Header_Margin DO WRITELN(LST);
  109.      END;
  110.  
  111.    {
  112.    Reassign TURBO's CONIN function to user-defined so that keyboard input
  113.    can be trapped by this program.
  114.    }
  115.    Abort := FALSE;
  116.    CONINPTR := ADDR(User_ConIn);
  117.    WHILE NOT EOF(Text_File) DO
  118.     BEGIN
  119.      READLN(Text_File, Line);
  120.      LineCount := LineCount + 1;
  121.      IF Abort THEN Ch := ^C ELSE Ch := 'P';
  122.      Abort_TLIST;
  123.      WRITE(^M, 'Processing Line ', LineCount);
  124.      CLREOL;
  125.      Includes(Line, Include_file_present, Include_file_name);
  126.      Process_Line;
  127.      IF Include_file_present THEN
  128.       BEGIN
  129.        FOR I := 1 TO LENGTH(Include_file_name) DO
  130.         Include_file_name[I] := UPCASE(Include_file_name[I]);
  131.        ASSIGN(Include_File, Include_file_name);
  132.        {$I-}
  133.        RESET(Include_File);
  134.        {$I+}
  135.        IF IORESULT <> 0 THEN
  136.         BEGIN
  137.          WRITELN;
  138.          WRITELN('Cannot find include file, ', Include_file_name);
  139.          Ch := ^C;
  140.          Abort_TLIST;
  141.         END;
  142.        WHILE NOT EOF(Include_File) DO
  143.         BEGIN
  144.          READLN(Include_File, Line);
  145.          LineCount := LineCount + 1;
  146.          IF Abort THEN Ch := ^C ELSE Ch := 'P';
  147.          Abort_TLIST;
  148.          WRITE(^M, 'Processing Line I', LineCount);
  149.          CLREOL;
  150.          Includes(Line, Include_file_present, Include_file_name);
  151.          IF Include_file_present THEN
  152.           BEGIN
  153.            WRITELN;
  154.            WRITELN('Include directive in include file not allowed!');
  155.            Ch := ^C;
  156.            Abort_TLIST;
  157.           END;
  158.          Process_Line;
  159.         END;
  160.        CLOSE(Include_File);
  161.       END;
  162.     END;
  163.    IF DiskFile THEN
  164.     BEGIN
  165.      WRITE(List_file, ^L);
  166.      CLOSE(List_file);
  167.     END
  168.    ELSE
  169.     WRITE(LST, ^L);
  170.    CLOSE(Text_File);
  171.    WRITE(^M, Page_number, ' pages.');
  172.    CLREOL;
  173.    WRITELN;
  174.   END;
  175. END.
  176.