Program lister;  { Listing program     version  2.2     31 May   1985  }
{$c-}
{***********************************************************}
{  listing program for pascal and other programs            }
{                                                           }
{  note the cross index and inline index's are only         }
{  good when listing Pascal programs                        }
{                                                           }
{  Written in :   Turbo Pascal  v 2.0                       }
{                                                           }
{  written by :  John Lindsay                               }
{                Shrewsbury, Ma                             }
{                                                           }
{                FOG 1131                                   }
{                                                           }
{  Date :  4 Feb 1985                                       }
{                                                           }
{  rev 1.3  10 Feb 1985                                     }
{                                                           }
{      Corrected Screen printout for proper reaction        }
{      when printer not connected.                          }
{                                                           }
{           .pa    in column 1..5 will cause a page feed    }
{                                                           }
{           .po n  in column 1..5 will set the left margin  }
{                  to n.  Default is 6                      }
{                                                           }
{  rev 2.0  8 Mar 1985                                      }
{                                                           }
{      corrected directory and added various printer        }
{      commands                                             }
{                -- double Strike                           }
{                -- Emphasized                              }
{                -- Char per inch                           }
{                -- Disable headers                         }
{                -- Tab setting                             }
{                                                           }
{      also clears the 8th bit to allow printing            }
{      wordstar files without having graphic charactors     }
{      show up in the printout                              }
{                                                           }
{  Rev 2.1  15 Mar 1985                                     }
{                                                           }
{      added Near Letter Quality printout with or without   }
{      proportional spacing in 10 or 12 cpi sizes           }
{                                                           }
{              ^BBoldface^B                                 }
{              ^Sunderscore^s                               }
{              ^dDouble Strike^d   all work in NLC mode     }
{                                                           }
{      .UJ is used within text to toggle the proprotional   }
{      spacing.                                             }
{                                                           }
{  Rev 2.2  31 May 1985                                     }
{                                                           }
{      corrected the screen printout again and              }
{      prevended system crash when large numbers of         }
{      procedures are listed or called                      }
{                                                           }
{***********************************************************}
{.pa}
(*
                   Note : the entire included document file
                          is removed from the program during
                          compiling
{$I lister21.doc}
*)
{.pa}
label exit,exit2;

Const Heading  = 'Listing Program for Pascal Programs          ';
      Heading2 = 'Listing File : ';
      Heading3 = 'Include File : ';
      Page_length : integer = 88;
      margin      : string[255] = '      '; { 6 }
      Boldface    : boolean = false;
      Double_strike : boolean = false;
      Underline   : boolean = false;
      Max_num_of_procedures  = 100;
      Max_num_of_calls       = 500;

{   change these lines to set up underline for your printer  }

      Star_underline_on  : string[5] = ^['-'^a;   { esc '-' chr (1) }
      Star_underline_off : string[5] = ^['-'^@;   { esc '-' chr (0) }

{   if it is not a 3 charactor sequence then the line in Print_string }
{   will have to be changed to match                                  }

      Printer_elite_string : string[8] = ^['B'^b;
      Printer_setup_string : string[8] = ^o^['0';   {  17 cpi & 8 lpi           }
      printer_reset_string : string[8] = ^['@';     {  resets printer to normal }
      Printer_tab_string   : string[20] = ^['D'^h^p^x' (08@HPX`hpx'^@; { this might need to be cleared }
                                                                       { for some epson printers       }
      printer_double_strike : string[8] = ^['G';
      printer_emphasized    : string[8] = ^['E';
      printer_indexes_per_inch : integer = 144; { for some epson printers, this }
                                                { is 216                        }
      Proportional_print   : boolean = false;
      Char_per_inch : integer = 17;
      headings      : boolean = true;
      Emphasized    : boolean = false;
      Pro_print     : boolean = false;

Type lstr            = string [255];
     str255          = string [255];
     soc             = set of char;

     index           = record
                       name   : string[35];
                       pg_num : integer;
                       end;

     Calls           = record
                       Id   : integer;
                       Line : integer;
                       end;
{.pa}
var  F,FI,F1         : text;
     line            : string [255];
     otptr           : text;
     i,page_line,
     count,time,
     page,n,x,
     program_line,
     include_line    : integer;
     File_name,
     Disk_file_name,
     Include_file    : string [15];
     Start,Stop      : integer;
     include,Index_in_text,
     included_files,Disk_file,
     Number_include,Screen_file,
     Number_lines,cross_index,
     PA,stopp        : boolean;
     Ch              : char;
     temp4           : string[4];
     temp            : string[255];
     interupt,dot    : boolean;
     proceed         : array [1..Max_num_of_procedures] of index;
     num_of_procedures : integer;
     xref            : array [1..Max_num_of_calls] of calls;
     xref_count      : integer;
{.pa}
{$I letters.dat}
{.pa}
{$I prtpro.pas}
{.pa}
{$I edit.inc}
{.pa}
{$I lister.1}
{.pa}
begin
     cross_index := true;
     included_files := true;
     number_lines := true;
     number_include := false;
     Disk_file_name := 'Data.lst';
     Index_in_text := true;
     include := false;
     Disk_file := false;
     Screen_file := false;
     num_of_procedures := 0;
     xref_count := 0;
     interupt :=false;
     Pa := false; start := 1;  stop :=9999;
     get_command;
     ASSIGN (F1,Disk_file_name);
     if Screen_file then
         IODIRECT (0,ADDR(F1))
       ELSE
         if not(disk_file) then
             IODIRECT (3,ADDR(F1))
           else
             IODIRECT (6,ADDR(F1));
     REWRITE (F1);
     if (File_name <> '') and (ch <> 'Q') then
         begin
         writeln;
         if not(interupt) and not(screen_file or disk_file) then
             begin
             line := ^[+'@';
             if char_per_inch = 17 then
                 line := line + printer_setup_string+Printer_tab_string
               else
                 if char_per_inch = 10 then
                     line := line + Printer_tab_string
                   else
                     line := line + Printer_elite_string + Printer_tab_string;
             if emphasized then line := line + printer_emphasized;
             if Double_strike then line := line + printer_double_strike;
             for count := 1 to length(line) do
                 begin
                 time := 0;
                 if not(interupt) then
                     begin
                     repeat
                         ch := chr(bdos(6,255));
                         if time = 2000 then
                             begin
                             gotoxy (1,23);
                             write (' Turn on printer OR press <ESC> ');
                             clreol;
                             time := 2001;
                             end;
                         if time < 2000 then time := time + 1;
                         until (bios(14) <> 0) or (ch = ^[);
                     if ch = ^[ then interupt := true;
                     ch := chr(0);
                     end;
                 if not(interupt) then
                     write (f1,line[count]);
                 end;
             end;
         writeln;
         if not(screen_file) then
             write (chr(27),'=',chr(31+23),chr(32),' Press any key to stop printer');
         clreol;
{.pa}
         {  listing program  }
         Assign (f, file_name);
         {$I-}
         reset (F);
         {$I+}
         if ioresult <> 0 then
             begin
             writeln (^g,^j,^m,'FILE : ',file_name,' Not Found');
             halt;
             end;
         Page := 1;  Page_line := 1;   Program_line := 1;
         while not EOF (f) do
             begin
             if interupt then goto exit;
             if include and EOF (FI) then
                     include := false;
             line := '';
             repeat
                 if include then read (FI,ch)
                            else read (F,ch);
                 ch := chr(ord(ch) and $7F);
                 if ord(ch) = $1F then ch := chr($2D);    { convert soft hyphins to real ones  }
                 if ord(ch) <> $0A then line := line + ch;
                 if include then stopp := eof(FI)
                            else stopp := eof(F);
                 until (ord(ch) = $0A) or stopp;
             dot := false;
             compair (line);
             filter;
             print_header;
             if page > stop then goto exit;
             if (page>= start) and (page <= stop) and
                    (not(include) or (include and included_files)) then
                 begin
                 if Number_lines then
                     begin
                     str (program_line:4,temp4);
                     temp := temp4+' ';
                     str (include_line:4,temp4);
                     if include then temp := temp + temp4+' ';
                     end
                   else temp := '';
                 if not(interupt) and not(dot and not(number_lines)) then print_string (temp + line);
                 end;
{.pa}
             if (Included_files or (not(included_files) and number_include)) and
               ((pos ('{$I',string_upper_case(line)) in [1..2]) or
                (pos('.FI',string_upper_case(line)) in [1..5])) then
                   if (pos ('{$I+',string_upper_case(line)) = 0) and
                      (pos ('{$I-',string_upper_case(line)) = 0) then
                                              begin
                                              x := pos ('{$I',string_upper_case(line)) + 3 +
                                                   pos ('.FI',string_upper_case(line));
                                              include := true;
                                              Include_file := copy(line,x,length(line)-x);
                                              include_file := FilterStr(Include_file,[' '..'z']);
                                              include_file := TrimL (Include_file);
                                              assign (FI,include_file);
                                              {$I-}
                                              reset (FI);
                                              {$I+}
                                              if ioresult <> 0 then include := false;
                                              include_line := 0;
                                              end;
             Program_line := program_line + 1;
             Page_line := Page_line + 1;
             if include then include_line := include_line + 1;
             if Pa or ((Page_line > 70) and (char_per_inch = 17)) or ((Page_line > 55) and not(char_per_inch = 17)) then
                                     begin
                                     if (page >= start) and (page <= stop) and
                                        (not(include) or (include and included_files)) then
                                          Page_feed;
                                     page_line := 1;
                                     Page := Page + 1;
                                     PA := false;
                                     end;
             end;
         if page <= stop then Page_feed;
         page_line := 1;
         Page := Page + 1;
         PA := false;
         if cross_index and (num_of_procedures <> 0) and (ch <> 'Q') then
             cross_reference;
exit:
         close (f);
         if interupt or (page > stop) then goto exit2;
         end;
exit2:
     if not(interupt) and not(screen_file) and (ch <> 'Q') and (page <= stop) then
         write (f1,printer_reset_string);
     close (F1);
     end.
