home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PROLST.ZIP / PROGLIST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-11-08  |  34.8 KB  |  1,049 lines
  1. program ProgList;
  2. {$B-}
  3. {$U-}
  4.  (********************************************************************
  5.   *                 Program Lister  Version 1.00                     *
  6.   *                       by Donald Gloistein, 1986                  *
  7.   ********************************************************************
  8.  
  9.  
  10.   INSTRUCTIONS : type PROGLIST ? <CR> to see the help menu with defaults.
  11.  
  12.   This is the first draft version.  Please give me feedback on what would
  13.   be more convenient in the program.
  14.  
  15. **************************************************************************
  16.     Written by Don Gloistein , 1986
  17.       Telephone:  713-331-9372
  18.       CIS      :  76010,474
  19.       Addrress : 2500 Fairway Dr. #922
  20.                  Alvin, TX  77511
  21.  
  22.     This program is released to public domain for personal, non-
  23.     commercial use ONLY.  You may use it yourself, give it to your
  24.     friends, or distribute it for a cost-based fee as part of a user's
  25.     group or bulletin board service.
  26.  
  27.     As this is just a first draft program, it needs more features and
  28.     the ability to do more sophisicated printing.  When I have added all
  29.     of that, I feel I will be out of the realm of editing existing work
  30.     and into a new program.
  31. ********** A Unique ShareWare, Money or Help Me Improve the Program *****
  32.     If you ask for support or updates of this program, please expect
  33.     to make a donation.  This donation is either in the form of money or
  34.     sweat.  If you are a programmer like me, you like to improve programs
  35.     and make them more useful.  You teach me, that is worth money to me.
  36.     If this program is of use to you please consider a donation of $10.00.
  37.                            OR
  38.     Contribute Ideas:
  39.     As the program and source is fleshed out, only the compiled version and
  40.     the instalation programs will be given out.  The source code will be
  41.     shared with those who help with suggestions and programming hints.
  42.  
  43.     Compiled on Turbo Pascal ver 3.01A and MS-Dos.
  44. ***********************************************************************
  45.     Some routines may be Dos specific, please check.
  46.     These include the opening of the 'PRN' file and the MSDOS specific
  47.     cursor control.  These are easy to change.  Global change of the
  48.     OutFile to lst will make it print to the printer.  However, there
  49.     would be no ability to print to a file.  I don't know the way to
  50.     declare it in CP/M, so I hope the change is superficial.  I wanted
  51.     to avoid testing each Write statement against the PrintFile variable.
  52.     Otherwise, I am trying to write with the least amount of problems.
  53.     CAUTION: the Modify.Pas procedure (SaveDef.inc) works only for MSDOS
  54.     Turbo 3.01A.  The file date and time functions (FDTTM.INC) work with
  55.     MSDOS 3.01A.  They use file handles, these could be changed for other
  56.     versions, with little trouble.
  57. *************************************************************************)
  58.  
  59.  
  60. { ***********************Declarations  ************************* }
  61.  
  62. Const
  63.       Version = 'ProgList 1.00';
  64.       CopyRight = 'Copyright 1986, Don Gloistein';
  65.       Compiled = '11/08/86 13:04:00';
  66.       VidInt         =  $10;
  67.       SetCurFunct    = $100;
  68.       GetCurFunct    = $300;
  69.       MaxLine = 255;
  70.       PathLength  = 80;
  71.       FormFeed = #12;
  72.       lfcr =#13#10;
  73. (*
  74.   {Use if including Modify.inc otherwise comment out}
  75.  {SaveDef error  Constants}
  76.       Err0 = ' : Was modified successfully.';
  77.       Err1 = ' : Must be in logged directory.';
  78.       Err2 = ' : Error reading.';
  79.       Err3 = ' : Error writing.';
  80.       Err4 = ' : No error msg.';
  81.       Err5 = ' : Wrong Version or .COM file.';
  82.  Err : array[0..5] of string[40] = (Err0,Err1,Err2,Err3,Err4,Err5);
  83. (**)
  84.  
  85. type
  86.     PrtCtl = (PrtInit,BoldOn,BoldOff,UndOn,UndOff,ExpandOn,ExpandOff,
  87.                  CondOn,CondOff,PitchOne,PitchTwo,PrtEnd);
  88.     PrtOut = array[0..10] of byte;
  89.  const
  90. (* Typed constants will be used for the modify.inc procedure *)
  91.   VerCheck : string[14] = Version;  {Beginning of constants must remain}
  92.   ProgName : string[12] = 'PROGLIST.COM';  {Name used to find this program }
  93.   ProgPath : string[64] = ''            ;  {Path this program is in}
  94.   DefExt   : string[4]  = '.PAS';         {Insert changable constants here}
  95.   IncDefExt: string[4]  = '.PAS';         {May be set different for C lang}
  96.   QuickList         : boolean = False;    {Just list functions & procedures}
  97.   PageFeed          : boolean = False;    {New Page for include files}
  98.   Banner            : boolean = True;     {Main File Banner}
  99.   FirstFeed         : boolean = False;     {Start with form feed}
  100.   EndFeed           : boolean = True;    {End listing with form feed}
  101.   MainHeader        : boolean = False;    {Print upto the first procedure}
  102.   IncludePrint      : boolean = True;     {Print include files}
  103.   TabExpand         : boolean = False;    {Filters line, slows it down}
  104.   PageWidth         : integer = 80;
  105.   PrintLength       : integer = 55;       {Banners are included in count}
  106.   VerticalTabLength : integer = 3;        {To give upper page white space}
  107.   HorizTabLength    : integer = 2;        {Set for Pascal Listings, only used}
  108.                                           { if TabExpand is true}
  109.                                           { My printer does not expand tabs}
  110.   RightMargin       : integer = 0;
  111.   MaxColCheck       : integer = 20;       {Value to avoid GetWord obtaining}
  112.                                           {an Op word that was a parameter  }
  113.   PrintFile         : boolean = True;     {originally to test without using}
  114.                                           {the printer, left it in for quick}
  115.                                           {listings}
  116. { Beginning of the Byte Arrays for Printer Strings.}
  117.   PrtStr:  array[PrtCtl] of PrtOut =
  118.            (($FF,0,0,0,0,0,0,0,0,0,0),
  119.             ($FF,0,0,0,0,0,0,0,0,0,0),
  120.             ($FF,0,0,0,0,0,0,0,0,0,0),
  121.             ($FF,0,0,0,0,0,0,0,0,0,0),
  122.             ($FF,0,0,0,0,0,0,0,0,0,0),
  123.             ($FF,0,0,0,0,0,0,0,0,0,0),
  124.             ($FF,0,0,0,0,0,0,0,0,0,0),
  125.             ($FF,0,0,0,0,0,0,0,0,0,0),
  126.             ($FF,0,0,0,0,0,0,0,0,0,0),
  127.             ($FF,0,0,0,0,0,0,0,0,0,0),
  128.             ($FF,0,0,0,0,0,0,0,0,0,0),
  129.             ($FF,0,0,0,0,0,0,0,0,0,0));
  130.  {**** End of Printer Strings. ****************** }
  131.   Tail              : byte = 0;   {End of constants must remain this way}
  132.  
  133.   Keyword : Array[1..3] of String[10] = ('PROCEDURE','FUNCTION','OVERLAY');
  134.   Optword : Array[1..4] of String[10] = ('BEGIN','TYPE','CONST','VAR');
  135.   ChangeName: boolean = False;
  136.   digit   : set of char = ['0'..'9'];
  137.   PrintChar: set of char = [' '..'}'];
  138.   LineOfSpace: string[80] =
  139. '                                                                                 ';
  140.    {80 initialized spaces}
  141.   LnRdCount: integer = 0;
  142.   LnPrtCount: integer = 0;
  143.   InitCurs:   integer = 0;
  144. Type
  145.       WorkString = String[MaxLine];
  146.       FileName  = String[PathLength];
  147.       fvar = text[$4000];
  148.       BannerStr = String[MaxLine];
  149. Var
  150.       CurRow : integer;
  151.       PageNum: integer;
  152.       LoHiVid: Boolean;             {True if low video}
  153.       MainFileName: FileName;
  154.       OutPutName:   FileName;
  155.       MainFile: fvar;
  156.       OutFile: fvar;         {Used for output file}
  157.       Usage :string[80] ;
  158.       IncBannerStr : BannerStr;
  159.       MainBannerStr : BannerStr;
  160.       CurBanner     : ^BannerStr;
  161.       search1,search2,search3,search4: string[5];
  162.       DoSave: boolean;
  163.       Count, Count1 : Integer;
  164.       regs: record
  165.         case integer of
  166.             1: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: Integer);
  167.             2: (AL, AH, BL, BH, CL, CH, DL, DH: Byte)
  168.         end;
  169.  
  170. { ************************* End of declarations *************** }
  171.  
  172. {$I FDTTM.INC}
  173. {$I SAVEDEF.INC}
  174.  
  175. Procedure PrintTitle; { Prints the Program Title}
  176.   begin
  177.     writeln(Version,lfcr,CopyRight,lfcr,Compiled);
  178.   end; {PrintTitle}
  179.  
  180.  
  181. Procedure PrintBanner(page:Integer);
  182. { prints current banner string}
  183.   var
  184.      I,J : Integer;
  185.      temp: string[MaxLine];
  186.      pgstr: string[4];
  187.   begin
  188.      str(page:3,pgstr);
  189.      temp := '>> '+ CurBanner^ + ' Page: '+ pgstr + ' <<';
  190.      j := ((PageWidth - length(temp)) div 2) -2 ;
  191.      for I := 1 to J do
  192.         insert(#32,temp,1);
  193.      writeln(OutFile,temp,lfcr);
  194.      CurRow := CurRow +2;
  195.   end;
  196.  
  197. Procedure MakeBanner(var Str: BannerStr;var f: fvar;fname:FileName);
  198.     begin
  199.       str := Fname + ' Last Change: '+ ftime(f) + ' on '+ fdate(f) ;
  200.     End;
  201.  
  202.  
  203. Procedure readline(VAR f : fvar; var nl : WorkString);
  204. {read a line from the file and expand tabs into supplied string}
  205. {if TabExpand is True, this routine signif. slows processing}
  206.     var
  207.       I,O,J : Byte;
  208.       TempBuff: workstring;
  209.       Len : byte absolute TempBuff;
  210.     begin
  211.       LnRdCount := succ(LnRdCount);
  212.       GoToXy(56,1);
  213.       Write(LnRdCount);
  214.       Readln(f, nl);
  215.       if not TabExpand then exit
  216.          else move(nl[0],TempBuff[0],ord(nl[0])+1);
  217.       I := 1;
  218.       O := 0;
  219.       while I <= Len do begin
  220.         if TempBuff[I] = #9 then begin   {expand tabs}
  221.           O := succ(O);
  222.           J := 1;
  223.           while (J mod HorizTabLength) <> 0 do
  224.             J := succ(J);
  225.           move(LineOfSpace[1],nl[O],J);
  226.           O := O + J -1;
  227.         end else begin  {insert regular character}
  228.           if TempBuff[I] in PrintChar then   {filter characters}
  229.              begin
  230.                O := succ(O);
  231.                nl[O] := TempBuff[I];
  232.             End;
  233.         END;
  234.         I := succ(I);
  235.       END;
  236.       {set length of nl}
  237.       nl[0] := Chr(O);
  238.     END; {readline}
  239.  
  240.  
  241. Procedure UpCaseStr(Var S :workstring);
  242. {Makes string UpperCase, relax V if parameter is not WorkString}
  243.  
  244. Var
  245.   I : Integer;
  246. begin
  247.   For I := 1 to Length(S) do
  248.     S[I] := UpCase(S[I]);
  249. end;
  250.  
  251. Function KeyCheck(KW : WorkString) : Boolean;
  252. var
  253.   I : Integer;
  254. begin
  255.   KeyCheck := False;
  256.   UpCaseStr(KW);
  257.   For I := 1 to 3 do
  258.     if KW = Keyword[I] then
  259.       KeyCheck := True;
  260. end; {KeyCheck}
  261.  
  262. Function Optword_Check(KW : WorkString) : Boolean;
  263. {Returns True if the word is in the Keyword string}
  264.  
  265. var
  266.   I : Integer;
  267. begin
  268.   Optword_Check := False;
  269.   UpCaseStr(KW);
  270.   For I := 1 to 4 do
  271.     if KW = Optword[I] then
  272.       OptWord_Check := True;
  273. end;
  274.  
  275. Procedure GetFirstWord(PassedText : WorkString; Var First : WorkString);
  276. Var
  277.   J  : byte;
  278.  
  279. begin
  280.   move(PassedText[0],First[0],ord(PassedText[0])+1);
  281.   J := 0;
  282.   while (First[1]= #32 ) and (First[0] <> #0) do
  283.      if (succ(J) <> MaxColCheck) then   {Try to avoid false procedures}
  284.         delete(First,1,1);    {careful that we don't get an endless loop}
  285.   J := pos(#32,First);
  286.   if (J <> 0) then
  287.       First[0] := chr(J-1);  {else a null or full word already}
  288. End; {GetFirstWord}
  289.  
  290. function GetCursSize: integer;
  291. begin
  292.     Regs.AX := GetCurFunct;
  293.     Intr(VidInt,Regs);
  294.     GetCursSize := Regs.CX;
  295.   end; { GetCursSize }
  296.  
  297. procedure SetCursorMode(Size : integer);
  298.   begin
  299.     Regs.AX := SetCurFunct;
  300.     Regs.CX := Size;
  301.     Intr(VidInt,Regs);
  302.   end; { SetCursSize }
  303.  
  304.  
  305. Procedure Initial;
  306.   begin
  307.     CurRow := 1;
  308.     PageNum:= 1;
  309.     InitCurs := GetCursSize;
  310.     SetCursorMode($0F0F);
  311.     IncBannerStr :='';
  312.     MainBannerStr := '';
  313.     Regs.ah := 8;
  314.     Regs.bh := 0;
  315.     Intr(16, Regs);
  316.     LoHiVid := ((Regs.al and 8) = 0 );
  317.     Usage := copy(ProgName,1,(pos('.',ProgName)-1));
  318.     Usage := Usage + ' [?]|[MainFileName [OutFileName]] [-|/]I Q P B F M R# W# V# H# L# /S[X]';
  319.     clrscr;
  320.     PrintTitle;
  321.     MainFileName := '';
  322.     OutPutName := '';
  323.     search1 := '{$I';  { These assignments are now safe, checks }
  324.     search2 := '{$i';  { were placed in the Include file logic }
  325.     search3 := '(*$I'; { for examples and string assignments }
  326.     search4 := '(*$i';
  327.     DoSave := False;
  328.   end {initial};
  329.  
  330. procedure videxit;
  331.   begin
  332.     if LoHiVid then
  333.        LowVideo
  334.     else
  335.        HighVideo;
  336.     SetCursorMode(InitCurs);
  337.     halt;
  338.  End;
  339.  
  340.  
  341. Function Open(var fp:fvar; name: Filename): boolean;
  342.   begin
  343.     Assign(fp,Name);
  344.     {$I-}
  345.     reset(fp);
  346.     {$I+}
  347.     If IOresult <> 0 then
  348.      begin
  349.       Open := False;
  350.       close(fp);
  351.      end
  352.     else
  353.       Open := True;
  354.   end { Open };
  355.  
  356. Procedure Tell_Usage;
  357.   Begin
  358.     writeln(Usage,lfcr);
  359.     VidExit
  360.   End;
  361.  
  362. Procedure GetOutPutName;
  363.   var
  364.     TempStr: FileName;
  365.  
  366.   begin
  367.     if OutPutName <> '' then exit;
  368.     GotoXy(1,10);
  369.     Write('File to Print to?  : ');
  370.     ReadLn(OutPutName);
  371.     GoToXy(1,10);
  372.     ClrEol;
  373.   End;  {GetOutPutName}
  374.  
  375. Procedure GetNewName;
  376.   var
  377.     TempStr: FileName;
  378.     TempStr2:FileName;
  379.     Ch     : Char;
  380.   Begin
  381.     Writeln(lfcr,'This will change the default Name or Path for the program:');
  382.     Writeln(lfcr,'    Current ProgName    : ',ProgName);
  383.     Write(       'Enter new one or <ENTER>: ');
  384.     ReadLn(TempStr);
  385.     if (TempStr <>'') and (Ord(TempStr[0]) <= 8) then
  386.         begin
  387.         {$V-}
  388.         UpCaseStr(TempStr);
  389.         {$V-}
  390.         if pos('.',TempStr) = 0 then
  391.             TempStr := TempStr + '.COM';
  392.         end
  393.         else
  394.         TempStr := ProgName;
  395.     WriteLn(lfcr,'    Current Path        : ',ProgPath);
  396.     Write(       'Enter new one or <ENTER>: ');
  397.     ReadLn(TempStr2);
  398.     {$V-}
  399.     UpCaseStr(TempStr2);
  400.     {$V+}
  401.     if (TempStr2[ord(TempStr2[0])] <> '\') then
  402.        if (ord(TempStr2[0]) <>0) then
  403.           TempStr2 := TempStr2 + '\';
  404.     Writeln(lfcr,'New Name and Path       : ',TempStr2 + TempStr);
  405.     Write(       '  Is this correct? <Y,N>  ');
  406.     read(kbd,Ch);
  407.     Writeln(Ch);
  408.     if UpCase(Ch) = 'Y' then
  409.           begin
  410.           ProgPath := TempStr2;
  411.           ProgName := TempStr;
  412.           End
  413.     else
  414.        begin
  415.        Writeln(lfcr,'              >> NO CHANGES MADE <<');
  416.        VidExit;
  417.        End;
  418.   End; {GetNewName}
  419.  
  420. Procedure Help;
  421.  Begin
  422.   Writeln(Usage);
  423.   Writeln('Options:');
  424.   Writeln('  /Q           QuickList (just headings)     default = ',QuickList);
  425.   Writeln('  /A           All Lines (NOT /Q)            default = ',not QuickList);
  426.   Writeln('  /I[+|-]      List the Include files        default = ',IncludePrint);
  427.   Writeln('  /P[+|-]      Page top for include files    default = ',PageFeed);
  428.   Writeln('  /F[+|-]      Begin with form feed          default = ',FirstFeed);
  429.   Writeln('  /E[+|-]      End with Form Feed            default = ',EndFeed);
  430.   Writeln('  /B[+|-]      Print Banner type listing     default = ',Banner);
  431.   Writeln('  /M[+|-]      Print Main file Header        default = ',MainHeader);
  432.   Writeln('  /T[+|-]      Tab expansion (filters ^char) default = ',TabExpand);
  433.   WriteLn('  /O[+|-|#]    Output to file (# for prompt) default = ',PrintFile);
  434.   Writeln('  /Rn          Right Margin Indent to n      default=  ',RightMargin);
  435.   Writeln('  /Wn          Set page width to n           default = ',PageWidth);
  436.   Writeln('  /Vn          Set Vert Tab to n             default = ',VerticalTabLength);
  437.   Writeln('  /Hn          Set Horizontal tab to n       default = ',HorizTabLength);
  438.   Writeln('  /Ln          Set Page number of lines to n default = ',PrintLength);
  439.   Writeln('  /Daaa        Main Default Extension to aaa default = ',DefExt);
  440.   Writeln('  /Caaa        Incl Default Extention to aaa default = ',IncDefExt);
  441.   Writeln('Note: Default extension changes must be last or separate');
  442.   Writeln('  /S[X]  Set new Defaults and Save to ',ProgPath,ProgName);
  443.   WriteLn(' X is used with /S to prompt for new Path and Name or default is used.');
  444.   VidExit;                         {Note: This procedure does NOT return}
  445. End; {Help}
  446.  
  447. Function Exist(var fn: FileName):Boolean;
  448.    begin
  449.    Assign(OutFile,fn);
  450.    {$I-}
  451.    Reset(OutFile);
  452.    {$I+}
  453.    Exist := (IOresult = 0);
  454.    close(OutFile);
  455.    end;  {Exist}
  456.  
  457. procedure ProcCommLine;
  458.  
  459. Var
  460.   Param:                FileName;
  461. { ConfigName:           FileName; } {Used for /SX and modify.inc}
  462.   Loop,result,temp:     Integer;
  463.   I,J :                 Byte;
  464.   numstr:               string[4];
  465.   tempstr:              ^FileName;
  466.   Ch:                   Char;
  467. Begin
  468.   if ParamCount <> 0 then
  469.   begin
  470.   if (ParamStr(1) = '?') then
  471.      Help;
  472.   For Loop := 1 to ParamCount do
  473.   Begin
  474.  
  475.     Param := ParamStr(Loop);
  476.  
  477.     While Param <> '' do
  478.     Begin
  479.  
  480.       If    (Param[1] in ['/','-'])      {this is a parameter}
  481.       Then
  482.        Begin
  483.          while (ord(Param[0]) >1)  do
  484.               Begin
  485.               Case UpCase(Param[2]) of
  486.                 'A':  Begin
  487.                         quicklist := false;
  488.                       End;
  489.                 'B':  Begin
  490.                       if (Param[3] = '-') then
  491.                          Banner := False
  492.                       else
  493.                          Banner := True;
  494.                       End;
  495.                 'C':  Begin
  496.                          IncDefExt := copy(Param,3,3);
  497.                          insert('.',IncDefExt,1);
  498.                          Param := '';
  499.                       End;
  500.                 'D':  Begin
  501.                          DefExt := copy(Param,3,3);
  502.                          insert('.',DefExt,1);
  503.                          Param := '';
  504.                       End;
  505.                 'E':  Begin
  506.                       if (Param[3] = '-') then
  507.                          EndFeed := False
  508.                       else
  509.                          EndFeed := True;
  510.                       End;
  511.                 'F':  Begin
  512.                       if (Param[3] = '-') then
  513.                          FirstFeed := False
  514.                       else
  515.                          FirstFeed := True;
  516.                       End;
  517.                 'H':  Begin
  518.                       if (Param[3] in digit) then
  519.                          begin
  520.                          I :=3;
  521.                          while (Param[I] in digit) do
  522.                             I := succ(I);
  523.                          numstr := copy(Param,3,I -3);
  524.                          val(numstr,Temp,result);
  525.                          if (result <> 0) then
  526.                             writeln('I=',I,'/H Val error = ',result,' Str ',numstr)
  527.                          else HorizTabLength := Temp;
  528.                          end;
  529.                       End;
  530.                 'I':  Begin
  531.                       if (Param[3] = '-') then
  532.                          IncludePrint := False
  533.                       else
  534.                          IncludePrint := True;
  535.                       End;
  536.                 'M':  Begin
  537.                       if (Param[3] = '-') then
  538.                          MainHeader := False
  539.                       else
  540.                          MainHeader := True;
  541.                       End;
  542.                 'O':  Begin
  543.                       if (Param[3] = '-') then
  544.                          PrintFile := False
  545.                       else
  546.                          PrintFile := True;
  547.                       if (Param[3] = '#') then
  548.                          GetOutPutName;
  549.                       End;
  550.                 'P':  Begin
  551.                       if (Param[3] = '-') then
  552.                          PageFeed := False
  553.                       else
  554.                          PageFeed := True;
  555.                       End;
  556.                 'Q':  Begin
  557.                          QuickList := True;
  558.                       End;
  559.                 'R':  Begin
  560.                       if (Param[3] in digit) then
  561.                          begin
  562.                          I :=3;
  563.                          while (Param[I] in digit) do
  564.                             I := succ(I);
  565.                          numstr := copy(Param,3,I -3);
  566.                          val(numstr,Temp,result);
  567.                          if (result <> 0) then
  568.                             writeln('I=',I,'/L Val error = ',result,' Str ',numstr)
  569.                          else RightMargin := Temp;
  570.                          end;
  571.                       End;
  572.                 'S':  Begin
  573.                       DoSave := True;
  574.                       if UpCase(Param[3]) = 'X' then
  575.                           begin
  576.                           ChangeName := True;
  577.                           delete(Param,2,1);
  578.                           end;
  579.                       End;
  580.                 'T':  Begin
  581.                       if (Param[3] = '-') then
  582.                          TabExpand := False
  583.                       else
  584.                          TabExpand := True;
  585.                       End;
  586.                 'V':  Begin
  587.                       if (Param[3] in digit) then
  588.                          begin
  589.                          I :=3;
  590.                          while (Param[I] in digit) do
  591.                             I := succ(I);
  592.                          numstr := copy(Param,3,I -3);
  593.                          val(numstr,Temp,result);
  594.                          if (result <> 0) then
  595.                             writeln('I=',I,'/V Val error = ',result,' Str ',numstr)
  596.                          else VerticalTabLength := Temp;
  597.                          end;
  598.                       End;
  599.                 'W':  Begin
  600.                       if (Param[3] in digit) then
  601.                          begin
  602.                          I :=3;
  603.                          while (Param[I] in digit) do
  604.                             I := succ(I);
  605.                          numstr := copy(Param,3,I -3);
  606.                          val(numstr,Temp,result);
  607.                          if (result <> 0) then
  608.                             writeln('I=',I,'/W Val error = ',result,' Str ',numstr)
  609.                          else PageWidth := Temp;
  610.                          End;
  611.                       End;
  612.                 '?':  Begin
  613.                       Help;
  614.                       End;
  615.                 Else  Begin
  616.                         Writeln('Invalid option: ',Param[2],lfcr);
  617.                         Tell_Usage;
  618.                       End;
  619.               End; {case}
  620.  
  621.                                                {Now Clean up parameter line}
  622.               delete(Param,2,1);               {remove first parameter letter}
  623.               if (Param[2] in ['+','-','#']) then  {remove + or -or #}
  624.                  delete(Param,2,1);
  625.                                        {Remove any digits and check for length}
  626.                                        { or else WILL GET INTO ENDLESS LOOP}
  627.               while (Param[2] in digit )
  628.               and (ord(Param[0]) <>1) do
  629.                  delete(Param,2,1);
  630.                                        {Test if more parameter letters }
  631.               if (ord(Param[0]) = 1) then
  632.                  Param :=''
  633.               End; {while}
  634.        End Else { If a parameter}
  635.        Begin           {this is a filename }
  636.               If    MainFileName = ''
  637.               Then  Begin
  638.                       MainFileName := Param;
  639.                       Param := '';
  640.                     End
  641.               Else  Begin { Two Files Entered on Command Line}
  642.                     if OutPutName = ''
  643.                       Then Begin
  644.                            OutPutName := Param;
  645.                            {$V-}
  646.                            UpCaseStr(OutPutName);
  647.                            {$V+}
  648.                            Param := '';
  649.                            PrintFile := True;
  650.                            if pos('.',OutPutName) = 0 then
  651.                               OutPutName := OutPutName + '.PRN';
  652.                          end
  653.                        else Begin
  654.                               Writeln('Error: Three Files listed!');
  655.                               Tell_Usage;
  656.                             End;
  657.                      End;
  658.        End; {If a Parameter,else}
  659.     End; {while}
  660.    End; {for}
  661.   End; {if paramcount not zero}
  662.  
  663.   if DoSave then
  664.      Begin
  665.        if ChangeName then GetNewName;
  666.        I := SaveDef;  {Comment out if you want to use Modify.Inc}
  667.  
  668. (*     ConfigName := ProgPath + ProgName;        {set up file for modify}
  669.        I := Modify( ConfigName,VerCheck,Tail);  {comment out these two for }
  670.                                                 {SaveDef}  *)
  671.        clrscr;
  672.        writeln(lfcr,ProgName,Err[I]);
  673.        if I <> 0 then VidExit;
  674.        writeln('New Defaults for ',ProgPath,ProgName,':');
  675.        help;
  676.      End;
  677.   if Banner  then        {adjust so page doesnt double feed}
  678.      PrintLength := PrintLength -4;
  679.  
  680.   If    MainFileName = ''     {make sure a filename was given}
  681.   Then  Begin
  682.           GoToXy(1,10);
  683.           ClrEol;
  684.           Write('Enter Main Filename: ');
  685.           readln(MainFileName);
  686.           GoToXy(1,10);
  687.           ClrEol;
  688.           if (MainFileName = '') then
  689.              begin
  690.                Writeln(Usage,lfcr);
  691.                VidExit;
  692.              End;
  693.           if (MainFileName = '?') then
  694.              begin
  695.                clrscr;
  696.                help;
  697.              end;
  698.         End;
  699.    {String declarations dont match}
  700.    {$V-}
  701.  UpCaseStr(MainFileName);
  702.  {$V+}
  703.  if (pos('.',MainFileName) = 0) then
  704.      MainFileName := MainFileName + DefExt;
  705.   If Not Open(MainFile,MainFileName) Then
  706.     begin
  707.       Writeln('ERROR -- File not found:  ',MainFileName);
  708.       VidExit;
  709.     end;
  710.  if PrintFile then
  711.      begin
  712.        if OutPutName = '' then
  713.        begin
  714.          OutPutName := MainFileName;
  715.          delete(OutPutName,pos('.',MainFileName),4);
  716.          OutPutName := OutPutName + '.PRN';
  717.        end else
  718.             if (pos('.',OutPutName) = 0 ) then
  719.                OutPutName := OutPutName + '.PRN';
  720.        if Exist(OutPutName) then
  721.           begin
  722.             GoToXy(1,10);
  723.             clreol;
  724.             write(OutPutName,' exists, replace? <Y,N> ');
  725.             read(kbd,Ch);
  726.             write(Ch);
  727.             GoToXy(1,10);
  728.             clreol;
  729.             if UpCase(ch) = 'N' then
  730.               VidExit;
  731.           end;
  732.        Assign(OutFile,OutPutName);
  733.        {$I-}
  734.        rewrite(OutFile);
  735.        {$I+}
  736.        If IOresult <> 0 then
  737.        begin
  738.          WriteLn('ERROR -- File not open: ',OutPutName);
  739.          VidExit;
  740.        End
  741.        else begin
  742.          GoToXy(1,7);
  743.          Write('Writing to file: ',OutPutName);
  744.        end;
  745.      End else
  746.      begin
  747.        GoToXy(1,7);
  748.        Assign(OutFile,'PRN');
  749.        rewrite(OutFile);
  750.        Write('Listing to Printer');
  751.    end;
  752. End; {ProcCommLine}
  753.  
  754. Procedure VerticalTab;
  755.   var i: integer;
  756.   begin
  757.     for i := 1 to VerticalTabLength do
  758.   writeln(OutFile);
  759.   end {vertical tab};
  760.  
  761. Procedure ProcessLine(PrintStr: WorkString);
  762. var TwoRow:boolean;
  763. var J: integer;
  764. var TempStr: WorkString;
  765.   begin
  766.     J := length(PrintStr);
  767.     TwoRow := (J  >= (PageWidth - RightMargin));
  768.     LineOfSpace[0] := chr(RightMargin);
  769.     LnPrtCount := succ(LnPrtCount);
  770.     CurRow := succ(CurRow);
  771.     if TwoRow then
  772.        begin
  773.        TempStr := copy(PrintStr,1,(PageWidth - RightMargin ));
  774.        delete(PrintStr,1,(PageWidth - RightMargin ));
  775.        CurRow := succ(CurRow);
  776.        LnPrtCount := succ(LnPrtCount);
  777.        end;
  778.     if CurRow > PrintLength Then
  779.     begin
  780.       if banner then
  781.         begin
  782.         Writeln(OutFile,lfcr);
  783.         PrintBanner(PageNum);
  784.         End;
  785.       Write(OutFile,FormFeed);
  786.       PageNum := succ(PageNum);
  787.       VerticalTab;
  788.       if banner then
  789.         begin
  790.         PrintBanner(PageNum);
  791.         Writeln(OutFile);
  792.         end;
  793.       if TwoRow then
  794.          CurRow := 2
  795.       else
  796.          CurRow := 1;
  797.     end;
  798.     if TwoRow then
  799.        Writeln(OutFile,LineOfSpace,TempStr);
  800.     Writeln(OutFile,LineOfSpace,PrintStr);
  801.   end {Process line};
  802.  
  803. Procedure ProcessFile;
  804.  
  805.   var
  806.     LineBuffer: WorkString;
  807.     FirstWord : WorkString;
  808.     ToRow     : Integer;
  809. label   START;
  810.   Function IncludeCheck(VAR CurStr: WorkString): Boolean;
  811.      Var ChkChar: char;
  812.          column: integer;
  813.      begin
  814.        ChkChar := '-';
  815.        column := pos(search1,CurStr);
  816.        if column <> 0 then
  817.          chkchar := CurStr[column+3]
  818.        else
  819.        begin
  820.          column := Pos(search3,CurStr);
  821.          if column <> 0 then
  822.            chkchar := CurStr[column+4]
  823.          else
  824.          begin
  825.            column := Pos(search2,CurStr);
  826.            if column <> 0 then
  827.              chkchar := CurStr[column+3]
  828.            else
  829.            begin
  830.              column := Pos(search4,CurStr);
  831.              if column <> 0 then
  832.                chkchar := CurStr[column+4]
  833.            end;
  834.          end;
  835.        end;
  836.        {Check if include is a string assignment, Trying to be failsafe}
  837.        if ChkChar in ['+','-',''''] then IncludeCheck := False
  838.        Else IncludeCheck := True;
  839.      end { IncludeCheck };
  840.  
  841.  
  842.   Procedure ProcessIncludeFile(VAR IncStr: WorkString);
  843.  
  844.      var NameStart, NameEnd: integer;
  845.          IncludeFile: fvar;
  846.          IncludeFileName: Filename;
  847.  
  848.     Function Parse(IncStr: WorkString): WorkString;
  849.        begin
  850.          NameStart := pos('$I',IncStr)+2;
  851.          while IncStr[NameStart] = ' ' do
  852.            NameStart := Succ(NameStart);
  853.          NameEnd := NameStart;
  854.          while (not (IncStr[NameEnd] in [' ','}','*','''']))
  855.               AND ((NameEnd - NameStart) <= PathLength)
  856.               do NameEnd := Succ(NameEnd);
  857.          {An extra check to see if this is a string assignment}
  858.          if IncStr[NameEnd] = '''' then
  859.             begin
  860.               Parse := MainFileName;
  861.               exit;
  862.             end;
  863.          NameEnd := Pred(NameEnd);
  864.          Parse := copy(IncStr,NameStart,(NameEnd-NameStart+1));
  865.     end {Parse};
  866.  
  867.     begin  {Process include file}
  868.        ProcessLine(LineBuffer);
  869.        if not IncludePrint then
  870.           exit;
  871.        IncludeFileName := Parse(IncStr);
  872.        if (pos('.',IncludeFileName) = 0) then
  873.               IncludeFileName := IncludeFileName + IncDefExt;
  874.         {Some documentation has an example to include the documented file}
  875.         {Protect against recursive listings}
  876.        if IncludeFileName = MainFileName then
  877.           exit;
  878.        If not Open(IncludeFile,IncludeFileName) then
  879.        begin
  880.          LineBuffer := 'ERROR -- Include file not found:  ' + IncludeFileName;
  881.          ProcessLine(LineBuffer);
  882.        end
  883.        Else
  884.        begin
  885.          MakeBanner(IncBannerStr,IncludeFile,IncludeFileName);
  886.          CurBanner := addr(IncBannerStr);
  887.          if PageFeed and (CurRow <> 4) then  {Try to avoid single line pages}
  888.              begin
  889.                if banner then
  890.                begin
  891.                  for ToRow := CurRow to PrintLength do
  892.                     writeln(OutFile);
  893.                  PrintBanner(PageNum);
  894.                end;
  895.                write(OutFile,FormFeed);
  896.                PageNum := succ(PageNum);
  897.                VerticalTab;
  898.                CurRow :=1;
  899.                end
  900.              else begin
  901.                writeln(OutFile);
  902.                CurRow := succ(CurRow);
  903.                end;
  904.           GoToXy(1,5);
  905.           clreol;
  906.           write('Processing : ',IncBannerStr);
  907.           GoToXy(62,1);
  908.           Write('I');
  909.          if Banner then
  910.            PrintBanner(PageNum);
  911.          while not eof(IncludeFile) do
  912.            begin
  913.            if QuickList then
  914.             begin
  915.             ReadLine(IncludeFile,LineBuffer);
  916.              GetFirstWord(LineBuffer,FirstWord);
  917.              If KeyCheck(FirstWord) then
  918.                begin
  919.                  ProcessLine(LineBuffer);
  920.                  repeat
  921.                    ReadLine(IncludeFile,LineBuffer);
  922.                    GetFirstWord(LineBuffer,FirstWord);
  923.                    If NOT OptWord_Check(FirstWord) then
  924.                       if Ord(LineBuffer[0]) > 0 then
  925.                          ProcessLine(LineBuffer);
  926.                  until OptWord_Check(FirstWord)
  927.                end;
  928.             End Else Begin
  929.               ReadLine(IncludeFile,LineBuffer);
  930.               ProcessLine(LineBuffer);
  931.             End;
  932.        end;
  933.        close(IncludeFile);
  934.        if PageFeed then
  935.           begin
  936.              for ToRow := CurRow to PrintLength do
  937.                  writeln(OutFile);
  938.              if banner then
  939.                 PrintBanner(PageNum);
  940.              write(OutFile,FormFeed);
  941.              PageNum := succ(PageNum);
  942.              VerticalTab;
  943.              CurBanner := addr(MainBannerStr);
  944.              CurRow := 1;
  945.              if Banner then
  946.                 PrintBanner(PageNum);
  947.           end
  948.           else begin
  949.             if banner then
  950.                begin
  951.                CurBanner := addr(MainBannerStr);
  952.                PrintBanner(PageNum);
  953.                End;
  954.           End;
  955.      end;
  956.      GoToXy(1,5);
  957.      clreol;
  958.      Writeln('Processing: ',MainBannerStr);
  959.      GoToXy(62,1);
  960.      Write(' ');
  961.      CurBanner := addr(MainBannerStr); {this is to make sure}
  962.                                        {I think it is unnecessary}
  963.     end {Process include file};
  964.  
  965. begin  {ProcessFile}
  966.   MakeBanner(MainBannerStr,MainFile,MainFileName);
  967.   CurBanner := addr(MainBannerStr);
  968.   GoToxy(50,1);
  969.   Write('Line: ',LnRdCount);
  970.   if FirstFeed then
  971.      write(OutFile,FormFeed);
  972.   VerticalTab;
  973.   if banner then
  974.     begin
  975.       printbanner(PageNum);
  976.       Writeln(OutFile);
  977.     End;
  978.   GoToXy(1,5);
  979.   Write('Processing: ',MainBannerStr);
  980.   if MainHeader then
  981.     begin
  982.       While Not EOF(MainFile)  do
  983.         begin
  984.           ReadLine(MainFile,LineBuffer);
  985.             if IncludeCheck(LineBuffer) then
  986.               ProcessIncludeFile(LineBuffer)
  987.             else
  988.               GetFirstWord(LineBuffer,FirstWord);
  989.             If Not KeyCheck(FirstWord) then
  990.               ProcessLine(LineBuffer)
  991.             else goto START;
  992.         End;
  993.     End;
  994.   While NOT EOF(MainFile) do
  995.     begin
  996.      if QuickList then
  997.       begin   {quick option}
  998.         ReadLine(MainFile,LineBuffer);
  999.         if IncludeCheck(LineBuffer) then
  1000.            ProcessIncludeFile(LineBuffer)
  1001.         else
  1002.            GetFirstWord(LineBuffer,FirstWord);
  1003.         If KeyCheck(FirstWord) then
  1004.            begin
  1005. START:
  1006.              ProcessLine(LineBuffer);
  1007.              repeat
  1008.                ReadLine(MainFile,LineBuffer);
  1009.                if IncludeCheck(LineBuffer) then
  1010.                   ProcessIncludeFile(LineBuffer)
  1011.                else
  1012.                   begin
  1013.                     GetFirstWord(LineBuffer,FirstWord);
  1014.                     If NOT OptWord_Check(FirstWord) then
  1015.                        if Ord(LineBuffer[0]) > 0 then
  1016.                           ProcessLine(LineBuffer)
  1017.                   end;
  1018.              until OptWord_Check(FirstWord)
  1019.            End; {if keyword}
  1020.       End  Else {if quick option}
  1021.            begin
  1022.              ReadLine(MainFile,LineBuffer);
  1023.                if IncludeCheck(LineBuffer) then
  1024.                  ProcessIncludeFile(LineBuffer)
  1025.                else
  1026.                  ProcessLine(LineBuffer);
  1027.       end; {If QuickList}
  1028.     End; {While not EOF}
  1029.    close(MainFile);
  1030.    for ToRow := CurRow to PrintLength do
  1031.       writeln(OutFile);
  1032.    if banner then
  1033.       PrintBanner(PageNum);
  1034.    if EndFeed then
  1035.       write(OutFile,FormFeed);
  1036. end;  {ProcessFile}
  1037.  
  1038.  
  1039. BEGIN  {ProgList}
  1040.   Initial;
  1041.   ProcCommLine;
  1042.   ProcessFile;
  1043.   GoToXy(1,6);
  1044.   WriteLn('Lines Read: ',LnRdCount,' Lines Printed: ',LnPrtCount,lfcr);
  1045.   Flush(OutFile);
  1046.   Close(OutFile);
  1047.   VidExit;
  1048. END.  {ProgList}
  1049.