Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/LIST01.ZIP/LIST01.PAS

Pascal/Delphi Source File | 1980-01-01 | 9.9 KB | 339 lines

PROGRAM LIST; {12/27/84}

{ Revised version 6/9/85}

{ Compile with TURBO PASCAL.

LIST -  Program source code listing utility.

Will format and print standard ASCII files:
  -Allows up to 20 files to be specified to be printed batch style.
  -Paginates (standard 8 1/2 X 11 paper, 80-column printer).
  -Correct pagination even if some lines exceed right margin and printer
      "wraps" to next line.
  -Allows you to specify a left margin (default is 5), so listing can
      be inserted in loose-leaf binder.
  -Prints header with file name, system date, and page number.

Usage:

For printing several files (up to 20):
  Have printer ready, then type LIST <Enter> at DOS prompt and respond
  to prompts in program.  Accepts drive designator for non-default drive,
  but not DOS pathnames.  Begins printing immediately after left margin
  offset is entered.

For printing a single file:
  Issue command at DOS prompt as

          LIST filename.ext [left margin offset, default 5]
          e.g., LIST FOO.PAS 8

Author:
  Frank L. Eskridge
  2895 Hill Park Court
  Marietta, GA  30062
  [phone]                                                         }

{ Revision notice 6/9/85:

  1.  Added routine to automatically pick up system date (MS-DOS) and
      print as header.
  2.  Removed option to add user's header (I never used it except to
      put in the date).
  3.  Added option to enter at command line with this syntax:

              LIST [<filename>] [<left margin offset>]

              e.g.,  LIST FOO.PAS 12

       Default left margin is 5.                                        }


TYPE  namestring=STRING[14];

VAR
   input_file            :TEXT;
   filename              :ARRAY [1..20] OF NAMESTRING;
   header                :STRING[50];
   line                  :STRING[255];
   header_length,
   offset,i,c,y          :INTEGER;
   ok                    :BOOLEAN;

{The following routine reads the system date and is called by simply
using DATE where you wnat the date to appear.  This was copied from
a public domain program called DATETI.PAS, no credit given.
It is completely unchanged except I left off the Time function.
                                                                    }
type
  datetimetype = string[8];
  regtype = record
      ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
    end;

function date: datetimetype;
  var
    reg: regtype;
    y,m,d,w: datetimetype;
    i: integer;
  begin
    reg.ax:=$2A00;
    intr($21,reg);
    str(reg.cx:4,y);
    delete(y,1,2);
    str(hi(reg.dx):2,m);
    str(lo(reg.dx):2,d);
    w:=m+'/'+d+'/'+y;
    for i:=1 to length(w) do if w[i]=' ' then w[i]:='0';
    date:=w;
  end;
{End of DATE function.}

{ The next function is from a program by Jim Holtman of Randloph,
  New Jersey, called ARGLIST.PAS.  I cleaned it up a little in order
  to understand it myself, but basically it is unchanged.  The next
  paragraph is Holtman's.

  This provides capabilities similar to argc/argv in C. You can now
  read the argument list from your TURBO Pascal program. `argc' is
  actually a function that returns the number of parameters on the
  command line. Spaces are the separators between parameters. If the
  parameter is enclosed in quotes ('), then any characters can appear.
  If you want a quote, put two in the command line parameter.
                                                                        }


TYPE
    arglist_string = string[80];
CONST
    arglist_max = 20;
    arglist_number : integer = -1;
VAR
   argvlist : array[1..arglist_max] of ^arglist_string;

FUNCTION argv ( num : integer ) : arglist_string;
   VAR
      argument : arglist_string absolute cseg:$80;
      newparm,parmline : arglist_string;
      i,j : INTEGER;
      state : (leading_ws, non_quote, quoted, end_quote);
      inchar : CHAR;

      PROCEDURE saveparm;
         BEGIN
            IF arglist_number < arglist_max THEN
               BEGIN
                  arglist_number := arglist_number+1;
                  new(argvlist[arglist_number]);
                  argvlist[arglist_number]^ := newparm;
                  newparm := '';
               END;
         END;

   BEGIN {function argv}
      IF arglist_number = -1 THEN
         BEGIN
            arglist_number := 0;
            parmline := argument+' ';
            state := leading_ws;
            newparm := '';
            FOR i := 1 to length(parmline) DO
               BEGIN
                  inchar := parmline[i];
                  CASE state OF
                     leading_ws:
                        BEGIN
                           IF inchar = '''' THEN state := quoted
                           ELSE IF inchar <> ' ' THEN
                              BEGIN
                                 newparm := newparm+inchar;
                                 state := non_quote;
                              END;
                        END;

                     non_quote:
                        BEGIN
                           IF inchar = ' ' THEN
                              BEGIN
                                 saveparm;
                                 state := leading_ws;
                              END
                           ELSE newparm := newparm+inchar;
                        END;

                     quoted:
                        BEGIN
                           IF inchar = '''' THEN state := end_quote
                           ELSE newparm := newparm+inchar;
                        END;

                     end_quote:
                        BEGIN
                           IF inchar = '''' THEN
                              BEGIN
                                 newparm := newparm+inchar;
                                 state := quoted;
                              END
                           ELSE IF inchar <> ' ' THEN
                              BEGIN
                                 newparm := newparm+inchar;
                                 state := non_quote;
                              END
                           ELSE
                              BEGIN
                                 saveparm;
                                 state := leading_ws;
                              END;
                        END;
                  END; {case}
               END;
         END;

         IF (num > 0) AND (num <= arglist_number) THEN
            argv := argvlist[num]^
         ELSE argv := '';
   END; {function argv}


FUNCTION argc:integer;
  VAR
     dummy : arglist_string;
  BEGIN {function argc}
     IF arglist_number = -1 THEN
     BEGIN
        dummy := argv(1); {force evaluation}
        argc := arglist_number;
     END
     ELSE
        argc := arglist_number;
  END;

{End of command line argument functions}

PROCEDURE SPACE(number:INTEGER);
VAR x : INTEGER;
BEGIN
   FOR x := 1 TO number DO
      WRITE(lst,' ');
END;


PROCEDURE LINE_FEED;
BEGIN
   WRITELN(lst,'');
END;


PROCEDURE CONVERT_TO_UPPER(VAR allcaps:namestring);
VAR x       :INTEGER;
    ch      :CHAR;
    newword :NAMESTRING;
BEGIN
   newword := '';
   FOR x := 1 TO LENGTH(allcaps) DO
      BEGIN
         ch := allcaps[x];
         newword := newword + upcase(ch);
      END;
      allcaps := newword;
END;


PROCEDURE GET_FILENAMES;
VAR ch :CHAR;
BEGIN
   i := 1;
   REPEAT
      WRITE('Name of file to list on printer (CR to end): ');
      READLN(filename[i]);
      CONVERT_TO_UPPER(filename[i]);
      i := i+1;
   UNTIL filename[i-1] = '';
END;


PROCEDURE GET_OFFSET;
VAR cnum:   STRING[2];
    code:   INTEGER;
BEGIN
   REPEAT
      WRITE('Number of columns to offset left margin [5]: ');
      READLN(cnum);
      IF cnum = ''THEN cnum:='5';
      VAL(cnum,offset,code);
      IF (offset<0) OR (offset>50) THEN
         WRITELN(#7+'Please enter a number between 0 and 50...');
   UNTIL (offset>=0) AND (offset<51);
END;


PROCEDURE OPEN(name:namestring);
BEGIN
   ASSIGN(input_file,filename[c]);
   {$I-}RESET(input_file) {$I+};
   ok := (IOResult=0);
   IF NOT ok THEN WRITELN(#7+' ----> Invalid filename--ignoring.');
END;


PROCEDURE PRINT_FILE(name:namestring);
VAR page,ln : INTEGER;
BEGIN
   page := 1;
   header_length := LENGTH(filename[c])+offset+10;
   WHILE NOT EOF(input_file) DO
      BEGIN
         SPACE(offset);
         WRITE(lst,filename[c]+'  '+date);
         SPACE(65-header_length);
         WRITE(lst,'Page');
         WRITELN(lst,page:3);
         LINE_FEED;LINE_FEED;
         LN := 5;
         WHILE (LN < 60) AND (NOT EOF(input_file)) DO
            BEGIN
               READLN(input_file,line);
               SPACE(offset);
               WRITELN(lst,line);
               IF LENGTH(line) > 80-offset THEN LN := LN+1;
               LN := LN+1;
            END;
         WRITE(lst,^L);
         page := page + 1;
      END;
END;


BEGIN {main program}
   IF argc = 0 THEN BEGIN
      WRITELN('LIST --  Formats and prints up to 20 ASCII files.');
      WRITELN('(Single file: use command-line entry--syntax: ');
      WRITELN('  LIST filename.ext [left margin, default 5] ');
      WRITELN('         Example:  LIST FOO.PAS 8             )');
      WRITELN('-------------------------------------------------');
      GET_FILENAMES;
      GET_OFFSET;
      WRITELN;
   END;
   IF argc > 0 THEN BEGIN
      filename[1] := argv(1);
      CONVERT_TO_UPPER(filename[1]);
      IF argc = 2 THEN VAL(argv(2),offset,y) ELSE offset := 5;
      i := 3;
      WRITELN;WRITELN;WRITELN;
   END;

   FOR c := 1 TO (i-2) DO
      BEGIN
         WRITE('Printing ---> '+filename[c]);
         OPEN(filename[c]);
         IF ok THEN
            BEGIN
               PRINT_FILE(filename[c]);
               CLOSE(input_file);
               WRITELN(' ----> Done');
            END;
      END;
END.