home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / ZXREF.LBR / XREF1.IQC / XREF1.INC
Text File  |  2000-06-30  |  11KB  |  447 lines
  1.  
  2. (**************************************************)
  3. (*-------> Include file  #1  for XREF.PAS  <------*)
  4. (**************************************************)
  5.  
  6.  
  7. (* v. 0300pm, sun, 28.Sep.86, Glen Ellis *)
  8.  
  9. (*--------------------------------------------*)
  10. (*                                            *)
  11. (*     primary procedure   pInitialize        *)
  12. (*                                            *)
  13. (*--------------------------------------------*)
  14.  
  15. procedure pInitialize ( var IKeyModeChar : string1 );
  16.  
  17. VAR
  18. Ch: Char;
  19.  
  20.  
  21.  
  22. (*------------------------------*)
  23. (* sub procedure of pInitialize *)
  24.  
  25. procedure  pConnectFiles
  26. (var ConnectFlag : boolean; var CFKeyModeChar : string1 );
  27.  
  28. TYPE
  29. Linebuffer = string[80];
  30.  
  31. VAR
  32. ix  : byte;
  33. InChar    : Char;
  34. DotLen    : integer;
  35. DotPos    : integer;
  36.  
  37. (*--------------------------------*)
  38. (* sub procedure of pConnectFiles *)
  39.  
  40. procedure pGetNames( var GNKeyModeChar : string1 );
  41.  
  42. var
  43. OKchar : char; (* OK controller char *)
  44. GetNameChar : char; (* get name char *)
  45. GetModeChar : char; (* get mode char *)
  46. AgainChar  : char;
  47. AcceptChar : char; (* accept parameters char *)
  48. ok : boolean;
  49. x : integer;
  50.  
  51. begin
  52.  
  53.    OKchar := ' ';
  54.  
  55.    REPEAT  (* primary *) (* until OKchar = 'Y' *)
  56.  
  57.       WriteLn
  58.       ('Enter complete filename  ( .PRN, and .XRF appended as required)') ;
  59.       Write('Input File: ');
  60.       Readln(FileInID);
  61.  
  62.       (*---> Allow Exit *)
  63.  
  64.       DotLen := Length(FileInID);     (* Use an available variable *)
  65.  
  66.       If DotLen = 0 then
  67.       begin
  68.          clrscr;
  69.          writeln('No Filename Entered : HALT !');
  70.          HALT;  (* for a quick Sanity check ! *)
  71.       end;
  72.  
  73.       (*---> Append Extension *)
  74.  
  75.       (* since this version will parse both
  76.       (* dBASE and TurboPascal source files,
  77.       (* do not append a default extension.  (**)
  78.       (*    DotPos := Pos( '.', FileInID );
  79.       (*    If DotPos = 0 then  (* If NO extension (.) *)
  80.       (*    begin
  81.       (*       FileInID := ( FileInID + '.PAS' );
  82.       (*       DotPos  := Pos( '.', FileInID )
  83.       (*    end;
  84.       (**)
  85.  
  86.       DotPos := Pos( '.', FileInID );
  87.       (* Get base filename with dot *)
  88.       PrnOutID := Copy (FileInID, 1, DotPos);
  89.       XrfID := Copy (FileInID, 1, DotPos) ;
  90.  
  91.       (* and add the proper extension for OutFile PRN and XRF *)
  92.       PrnOutID := ( PrnOutID + 'PRN' );
  93.       XrfID := ( XrfID + 'XRF' );
  94.  
  95.       (*-------> Always Display Parameters *)
  96.  
  97.       AcceptChar := ' ';
  98.  
  99.       WriteLn (' Input is from : ',FileInID);
  100.       WriteLn (' Print Out to  : ',PrnOutID);
  101.       WriteLn (' Cross Ref to  : ',XrfID);
  102.  
  103.       Write ('Are these parameters Accepable (Y/N) ? ');
  104.       Read(Kbd,AcceptChar);
  105.       writeln;
  106.       AcceptChar := upcase(AcceptChar);
  107.  
  108.       (*-------> Again Fetch Parameters *)
  109.  
  110.       If AcceptChar <> 'Y' then
  111.       begin
  112.  
  113.          ClrScr;
  114.          gotoxy(00,05);
  115.          Writeln('---> Supply Complete Filenames <---', chr(7) );
  116.  
  117.          Write (' Input is from : ',FileInID,' : ');
  118.          Readln(FileInID);
  119.          Write (' Print Out to  : ',PrnOutID,' : ');
  120.          Readln(PrnOutID);
  121.          Write (' Cross Ref to  : ',XrfID,' : ');
  122.          Readln(XrfID);
  123.  
  124.          Write (' Is this OK (Y/N) ? ');
  125.          Read (Kbd,AgainChar);
  126.          writeln;
  127.          AgainChar := upcase(AgainChar);
  128.  
  129.       end;
  130.  
  131.       (**)
  132.       REPEAT  (* secondary *) (* until GNKeyModeChar = 'D','T' *)
  133.  
  134.          GNKeyModeChar := ' ';
  135.  
  136.          WriteLn('Enter  <D> dBASE  or  <T> Turbo Pascal   Source files ') ;
  137.          Write('  Xref MODE : ');
  138.          Readln(GNKeyModeChar);
  139.  
  140.          GNKeyModeChar := upcase(GNKeyModeChar);
  141.  
  142.          IF GNKeyModeChar = 'D'
  143.             then writeln('   mode := dBASE');
  144.  
  145.          IF GNKeyModeChar = 'T'
  146.             then writeln('   mode := Turbo Pascal');
  147.  
  148.       UNTIL GNKeyModeChar in ['D','T'];
  149.       (* secondary *)
  150.       (**)
  151.  
  152.       (*---> Always ? OK ? for exit *)
  153.  
  154.       OKchar := 'N';
  155.       Write (' Is this Information  OK (Y/N) ? ');
  156.       Read (Kbd,OKChar);
  157.       writeln;
  158.       OKchar := upcase(OKchar);
  159.  
  160.    UNTIL OKchar = 'Y';
  161.    (* primary *)
  162.  
  163. end;   (* "Sub Sub" Procedure pGetNames *)
  164.  
  165.  
  166.  
  167. (*------------------------------*)
  168. (* sub procedure of pInitialize *)
  169.  
  170. begin    (* procedure pConnectFiles *)
  171.  
  172.    FileInID := '';
  173.    FatalErrorStatus := false;
  174.    ConnectFlag := true;
  175.  
  176.    (*---> Get Parameters *)
  177.  
  178.    (**)
  179.    (* CALL *)
  180.    pGetNames( CFKeyModeChar );
  181.    (**)
  182.  
  183.    (*---> Files Opening Module *)
  184.  
  185.    Assign(FOut,PrnOutID);
  186.    ReWrite(FOut);
  187.  
  188.    if IOresult <> 0 then
  189.    begin
  190.       WriteLn('Could not open ',PrnOutID,' (print output file).');
  191.       ConnectFlag  := FALSE;
  192.       FatalErrorStatus  := TRUE;
  193.    end;
  194.  
  195.    assign(xout,XrfID);
  196.    ReWrite(Xout) ;
  197.  
  198.    if IOresult <> 0 then
  199.    begin
  200.       WriteLn('Could not open ',XrfID,' (xref output file).');
  201.       ConnectFlag := false;
  202.       FatalErrorStatus := true;
  203.    end;
  204.  
  205. end;  (* of pConnectFiles *)
  206.  
  207.  
  208.  
  209. (*---------------------------------------------------*)
  210. (*                                                   *)
  211. (*  primary procedure   pINITIALIZE                  *)
  212. (*                                                   *)
  213. (*---------------------------------------------------*)
  214.  
  215.  
  216. begin   (* procedure Initialize *)
  217.  
  218.    XrefTrace := true;   (* sends each new word to screen *)
  219.    IKeyModeChar := ' ';  (* select dBASE / TurboPascal Keywords *)
  220.  
  221.    bell := ^G;
  222.    GAPchar := ' ' ;
  223.    Currentline := 0;
  224.  
  225.    (**)
  226.    (* CALL *)
  227.    pConnectFiles( ConnectFlag, IKeyModeChar );
  228.    (**)
  229.  
  230.    (* returns : *)
  231.    (* ConnectFlag = logic *)
  232.    (* IKeyModeChar = string1 *)
  233.  
  234.    (*--------------------------------*)
  235.    (*-------  Pascal KeyWords -------*)
  236.  
  237.    IF ConnectFlag
  238.       and (IKeyModeChar = 'T')
  239.    then
  240.    begin
  241.  
  242.       Key[ 1] := 'ABSOLUTE';
  243.       Key[ 2] := 'AND';
  244.       Key[ 3] := 'ARRAY';
  245.       Key[ 4] := 'ASSIGN';
  246.       Key[ 5] := 'BEGIN';
  247.       Key[ 6] := 'BOOLEAN';
  248.       Key[ 7] := 'BYTE';
  249.       Key[ 8] := 'CASE';
  250.       Key[ 9] := 'CHAIN';
  251.       Key[10] := 'CHAR';
  252.       Key[11] := 'CHR';
  253.       Key[12] := 'CLOSE';
  254.       Key[13] := 'CONCAT';
  255.       Key[14] := 'CONST';
  256.       Key[15] := 'COPY';
  257.       Key[16] := 'DELETE';
  258.       Key[17] := 'DIV';
  259.       Key[18] := 'DO';
  260.       Key[19] := 'DOWNTO';
  261.       Key[20] := 'ELSE';
  262.       Key[21] := 'END';
  263.       Key[22] := 'EOF';
  264.       Key[23] := 'EOLN';
  265.       Key[24] := 'EXECUTE';
  266.       Key[25] := 'EXIT';
  267.       Key[26] := 'EXTERNAL';
  268.       Key[27] := 'FALSE';
  269.       Key[28] := 'FILE';
  270.       Key[29] := 'FILLChar';
  271.       Key[30] := 'FOR';
  272.       Key[31] := 'FORWARD';
  273.       Key[32] := 'FUNCTION';
  274.       Key[33] := 'GOTO';
  275.       Key[34] := 'IF';
  276.       Key[35] := 'IN';
  277.       Key[36] := 'INLINE';
  278.       Key[37] := 'INPUT';
  279.       Key[38] := 'INTEGER';
  280.       Key[39] := 'LABEL';
  281.       Key[40] := 'LENGTH';
  282.       Key[41] := 'MOD';
  283.       Key[42] := 'NIL';
  284.       Key[43] := 'NOT';
  285.       Key[44] := 'OF';
  286.       Key[45] := 'OR';
  287.       Key[46] := 'ORD';
  288.       Key[47] := 'OUTPUT';
  289.       Key[48] := 'PACKED';
  290.       Key[49] := 'PROCEDURE';
  291.       Key[50] := 'PROGRAM';
  292.       Key[51] := 'REAL';
  293.       Key[52] := 'RECORD';
  294.       Key[53] := 'REPEAT';
  295.       Key[54] := 'SET';
  296.       Key[55] := 'SHL';
  297.       Key[56] := 'SHR';
  298.       Key[57] := 'STRING';
  299.       Key[58] := 'SUCC';
  300.       Key[59] := 'TEXT';
  301.       Key[60] := 'THEN';
  302.       Key[61] := 'TO';
  303.       Key[62] := 'TRUE';
  304.       Key[63] := 'TYPE';
  305.       Key[64] := 'UNTIL';
  306.       Key[65] := 'VAR';
  307.       Key[66] := 'WHILE';
  308.       Key[67] := 'WITH';
  309.       Key[68] := 'WRITE';
  310.       Key[69] := 'WRITELN';
  311.       Key[70] := 'XOR';
  312.       
  313.       NumKeys := 70; (**)
  314.       
  315.       TabChar     := CHR(9);  { ASCII TabChar Character }
  316.       FormFeedChar := CHR(12);
  317.       GAPchar  := CHR(32);
  318.       Write('List file to console (Y/N)? <N>:');
  319.       Read(kbd,Ch);
  320.       Listing := ( (Ch='Y') OR (Ch='y') );
  321.       WriteLn; WriteLn;
  322.       
  323.    end; (* IF ConnectFlag and IKeyModeChar = 'T' *)
  324.    
  325.    (*-------------------------------*)
  326.    (*-------  dBASE KeyWords -------*)
  327.    
  328.    IF ConnectFlag
  329.       and (IKeyModeChar = 'D')
  330.    then
  331.    begin
  332.       
  333.       Key[ 1] := 'ACCEPT';
  334.       Key[ 2] := 'ADD';
  335.       Key[ 3] := 'ALL';
  336.       Key[ 4] := 'ALTERNATE';
  337.       Key[ 5] := 'AND';
  338.       Key[ 6] := 'APPEND';
  339.       Key[ 7] := 'ARCHIVE';
  340.       Key[ 8] := 'ASCENDING';
  341.       Key[ 9] := 'BEFORE';
  342.       Key[10] := 'BLANK';
  343.       Key[11] := 'BOTTOM';
  344.       Key[12] := 'BROWSE';
  345.       Key[13] := 'CANCEL';
  346.       Key[14] := 'CASE';
  347.       Key[15] := 'CHANGE';
  348.       Key[16] := 'CLEAR';
  349.       Key[17] := 'CONTINUE';
  350.       Key[18] := 'COPY';
  351.       Key[19] := 'COUNT';
  352.       Key[20] := 'CREATE';
  353.       Key[21] := 'DATE';
  354.       Key[22] := 'DEFAULT';
  355.       Key[23] := 'DELETE';
  356.       Key[24] := 'DESCENDING';
  357.       Key[25] := 'DISPLAY';
  358.       Key[26] := 'DO';
  359.       Key[27] := 'EDIT';
  360.       Key[28] := 'EJECT';
  361.       Key[29] := 'ELSE';
  362.       Key[30] := 'ENDCASE';
  363.       Key[31] := 'ENDDO';
  364.       Key[32] := 'ENDIF';
  365.       Key[33] := 'ERASE';
  366.       Key[34] := 'FIELD';
  367.       Key[35] := 'FILES';
  368.       Key[36] := 'FIND';
  369.       Key[37] := 'FOR';
  370.       Key[38] := 'FORM';
  371.       Key[39] := 'FORMAT';
  372.       Key[40] := 'FRONT';
  373.       Key[41] := 'GET';
  374.       Key[42] := 'GETS';
  375.       Key[43] := 'GO';
  376.       Key[44] := 'GOTO';
  377.       Key[45] := 'HEADING';
  378.       Key[46] := 'IF';
  379.       Key[47] := 'INDEX';
  380.       Key[48] := 'INSERT';
  381.       Key[49] := 'JOIN';
  382.       Key[50] := 'LIKE';
  383.       Key[51] := 'LIST';
  384.       Key[52] := 'LOCATE';
  385.       Key[53] := 'LOOP';
  386.       Key[54] := 'MARGIN';
  387.       Key[55] := 'MEMORY';
  388.       Key[56] := 'MODIFY';
  389.       Key[57] := 'NOTE';
  390.       Key[58] := 'OFF';
  391.       Key[59] := 'ON';
  392.       Key[60] := 'OR';
  393.       Key[61] := 'OTHERWISE';
  394.       Key[62] := 'PACK';
  395.       Key[63] := 'PICTURE';
  396.       Key[64] := 'PRIMARY';
  397.       Key[65] := 'PRINT';
  398.       Key[66] := 'QUIT';
  399.       Key[67] := 'READ';
  400.       Key[68] := 'RECALL';
  401.       Key[69] := 'RECORD';
  402.       Key[70] := 'REINDEX';
  403.       Key[71] := 'RELEASE';
  404.       Key[72] := 'REMARK';
  405.       Key[73] := 'RENAME';
  406.       Key[74] := 'REPLACE';
  407.       Key[75] := 'REPORT';
  408.       Key[76] := 'RESET';
  409.       Key[77] := 'RESTORE';
  410.       Key[78] := 'RETURN';
  411.       Key[79] := 'SAVE';
  412.       Key[80] := 'SAY';
  413.       Key[81] := 'SELECT';
  414.       Key[82] := 'SET';
  415.       Key[83] := 'SKIP';
  416.       Key[84] := 'SORT';
  417.       Key[85] := 'STORE';
  418.       Key[86] := 'STRUCTURE';
  419.       Key[87] := 'SUM';
  420.       Key[88] := 'TO';
  421.       Key[89] := 'TOP';
  422.       Key[90] := 'TOTAL';
  423.       Key[91] := 'UPDATE';
  424.       Key[94] := 'USE';
  425.       Key[95] := 'USING';
  426.       Key[96] := 'WAIT';
  427.       Key[97] := 'WHILE';
  428.       Key[98] := 'WITH';
  429.       
  430.       NumKeys := 99; (**)
  431.       
  432.       TabChar   := CHR(9);  { ASCII TabChar Character }
  433.       FormFeedChar := CHR(12);
  434.       GAPchar  := CHR(32);
  435.       Write('List file to console (Y/N)? <N>:');
  436.       Read(kbd,Ch);
  437.       Listing := ( (Ch='Y') OR (Ch='y') );
  438.       WriteLn; WriteLn;
  439.       
  440.    end; (* IF ConnectFlag and IKeyModeChar = 'D' *)
  441.    
  442.    
  443. end; (* of Initialize *)
  444.  
  445. (***************************************************************)
  446. (*:B:0*)
  447.