home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / utility / crossref / aak_xref / dolist.pas < prev    next >
Pascal/Delphi Source File  |  1986-06-23  |  9KB  |  257 lines
  1. PROCEDURE do_listing           ( VAR fv    : TEXT ;
  2.                                      title : titletype ;
  3.                                      fn    : file_Str ;
  4.                                      mode  : state ) ;
  5.  
  6. VAR
  7.    Path : File_Str ;
  8.    Name : String_08 ;
  9.    Ext  : String_03 ;
  10.  
  11.    PROCEDURE bugout;
  12.  
  13.    BEGIN
  14.     parsing_for_dollars := false;
  15.     itsan_include := false;
  16.     itsa_directive := false
  17.    END;
  18.  
  19.  
  20.    PROCEDURE isitan_include;
  21.  
  22.    BEGIN
  23.       while f = ' ' do
  24.       BEGIN
  25.          Add_Line_Ch ( Line , f ) ;
  26.          read ( fv , f )
  27.       END ;
  28.       incname:='';
  29.       REPEAT
  30.          Add_Line_Ch ( Line , f ) ;
  31.          incname :=incname + f;
  32.          read(fv,f);
  33.       UNTIL NOT (f in ['.','\',':','A'..'Z','a'..'z','_','0'..'9']);
  34.       File_Separator ( IncName, Path, Name, Ext ) ;
  35.       IF Ext = '' THEN incname := incname + '.PAS';
  36.       IncName := Fix_Path_Str ( Main_Path + IncName ) ;
  37.       IF NOT ( 'T' IN Switches )
  38.       THEN BEGIN (* REGULAR INCLUDED THIS SUCKS *)
  39.               IF Exist ( Incname )
  40.               THEN BEGIN (* INCLUDED EXISTS *)
  41.                       assign ( iv , incname);
  42.                       Reset ( iv ) ;
  43.                       IF NOT ('S' in switches) THEN
  44.                       BEGIN
  45.                          WRITELN ;
  46.                          WRITELN;
  47.                          WRITE ('  Listing include file ',incname);
  48.                          IF 'F' in switches THEN WRITELN(' to file ',outname)
  49.                          ELSE WRITELN;
  50.                          WRITE('  Processing line #')
  51.                       END;
  52.                       taken_careof := False ;
  53.                       do_listing ( iv , 'Include' , incname , none ) ;
  54.                       New_Page ( fv , fn , title ) ;
  55.                       taken_careof := true;
  56.                       IF NOT ('S' in switches) THEN
  57.                       BEGIN
  58.                          WRITELN;
  59.                          WRITELN;
  60.                          WRITE ('Listing main file ',File_Name);
  61.                          IF 'F' in switches THEN WRITELN(' to file ',outname)
  62.                          ELSE WRITELN;
  63.                          WRITE ('Processing line #')
  64.                       END;
  65.                   END  (* INCLUDED EXISTS *)
  66.              ELSE WRITELN ('Error included File : ',Incname ,' does not exist ' ) ;
  67.           END
  68.      ELSE BEGIN (* SAVE FILE NAMES *)
  69.               IF Memory > Min_Memory THEN
  70.               BEGIN (* ENOUGH MEMORY *)
  71.                  NEW ( Inc_Last ) ;
  72.                  WITH Inc_Last^ DO
  73.                  BEGIN (* WITH *)
  74.                     Prev := Inc_Root ;
  75.                     Inc_File_Name := IncName ;
  76.                     Inc_Title := 'Included' ;
  77.                  END ; (* WITH *)
  78.                  Inc_Root := Inc_Last ;
  79.               END ; (* ENOUGH MEMORY *)
  80.            END ; (* SAVE FILE NAMES *)
  81.       parsing_for_dollars := false;
  82.       itsa_directive      := false;
  83.       itsan_include       := false;
  84.    END ; (* NESTED ITS AN INCLUDED *)
  85.  
  86.  
  87.    PROCEDURE Symbol_Parsing ;
  88.    BEGIN (* NESTED SYMBOL PARSING *)
  89.       IF f in ['.','a'..'z','A'..'Z','0'..'9','_']
  90.       THEN BEGIN
  91.               id := id + f;
  92.            END
  93.       ELSE BEGIN (* END NAME *)
  94.               WRITEid;
  95.               Add_Line_Ch ( Line , f ) ;
  96.               IF f = '''' THEN scan := quote
  97.               ELSE BEGIN (* NOT QUOTE *)
  98.                       IF f = '{'
  99.                       THEN BEGIN
  100.                               scan := com1;
  101.                               IF 'I' in switches THEN parsing_for_dollars := true
  102.                            END
  103.                       ELSE IF f = '(' THEN scan := pcom2
  104.                            ELSE  scan := none ;
  105.                    END ; (* NOT QUOTE *)
  106.            END ; (* END NAME *)
  107.    END ; (* NESTED SYMBOL PARSING *)
  108.  
  109.    PROCEDURE Com1_Parsing ;
  110.    BEGIN (* NESTED COM1 PARSING *)
  111.       Add_Line_Ch ( Line , f ) ;
  112.       IF ( f = '+' ) or ( f = '-' ) THEN bugout;
  113.       IF itsan_include THEN
  114.       BEGIN
  115.          isitan_include ;
  116.       END;
  117.       IF itsa_directive THEN
  118.       BEGIN (* IT IS A DERECTIVE *)
  119.          IF ( f = 'I' ) or ( f = 'i' )
  120.          THEN BEGIN
  121.                  itsan_include  := true;
  122.                  itsa_directive := false
  123.               END
  124.          ELSE itsa_directive := false;
  125.       END ; (* IT IS A DIRECTIVE *)
  126.       IF parsing_for_dollars THEN
  127.       BEGIN (* PARSING FOR DOLLARS *)
  128.          IF f = '$'
  129.          THEN BEGIN
  130.                  parsing_for_dollars :=false;
  131.                  itsa_directive := true
  132.               END
  133.          ELSE parsing_for_dollars := false;
  134.       END ; (* PARSING FOR DOLLARS *)
  135.       IF f = '}' THEN
  136.       BEGIN (* END OF COMMENT *)
  137.          parsing_for_dollars := false;
  138.          itsa_directive := false;
  139.          itsan_include := false;
  140.          scan := none
  141.       END ; (* END OF COMMENT *)
  142.    END ; (* NESTED COM1 PARSING *)
  143.  
  144.    PROCEDURE Pcom2_Parsing ;
  145.    BEGIN (* PCOM 2 PARSING *)
  146.       IF f in['a'..'z','A'..'Z','_']
  147.       THEN BEGIN
  148.               id := f;
  149.               scan := symbol
  150.            END
  151.       ELSE BEGIN
  152.               Add_Line_Ch ( Line , f ) ;
  153.               IF f = '''' THEN scan := quote
  154.               ELSE BEGIN
  155.                       IF f = '{'
  156.                       THEN BEGIN
  157.                               scan := com1;
  158.                               IF 'I' in switches THEN parsing_for_dollars := true ;
  159.                            END
  160.                       ELSE BEGIN
  161.                               IF f = '(' THEN scan := pcom2
  162.                               ELSE BEGIN
  163.                                       IF f = '*'
  164.                                       THEN BEGIN
  165.                                               scan := com2;
  166.                                               IF 'I' in switches THEN parsing_for_dollars := true ;
  167.                                            END
  168.                                       ELSE  scan := none
  169.                                    END ;
  170.                            END ;
  171.                    END ;
  172.            END ;
  173.    END ; (* PCOM 2 PARSING *)
  174.  
  175.    PROCEDURE Com2_Parsing ;
  176.    BEGIN
  177.       Add_Line_Ch ( Line , f ) ;
  178.       IF (f='+') or (f='-')  THEN bugout;
  179.       IF itsan_include THEN
  180.       BEGIN
  181.          isitan_include;
  182.       END;
  183.       IF itsa_directive  AND  ( ( f = 'I' ) OR ( f = 'i' ) )
  184.       THEN BEGIN (* IT IS A DIRECTIVE *)
  185.               itsan_include := true;
  186.               itsa_directive := false
  187.            END
  188.       ELSE itsa_directive := false;
  189.       IF parsing_for_dollars AND ( F = '$' )
  190.       THEN BEGIN
  191.               itsa_directive := true;
  192.               parsing_for_dollars := false
  193.            END
  194.       ELSE    parsing_for_dollars := false;
  195.       IF f = '*' THEN scan := pcom2x
  196.       ELSE BEGIN
  197.               IF (f = ')') and (lastf='*') THEN
  198.               BEGIN
  199.                  parsing_for_dollars := false;
  200.                  itsa_directive := false;
  201.                  itsan_include := false;
  202.                  scan := none
  203.               END ;
  204.            END ;
  205.    END ; (* COM2 PARSING *)
  206.  
  207.  
  208. BEGIN  (* DO LISTING *)
  209.    Fn := Fix_Path_Str ( Fn ) ;
  210.    scan                := mode ;
  211.    parsing_for_dollars := false;
  212.    itsa_directive      := false;
  213.    itsan_include       := false;
  214.    WHILE NOT EOF ( fv ) DO
  215.    BEGIN (* NOT END OF FILE *)
  216.    IF NOT Taken_Careof
  217.    THEN BEGIN (* First page title of current file *)
  218.            New_Page ( fv , fn , title ) ; (* File must be open *)
  219.            Taken_Careof := TRUE ;
  220.         END;
  221.    IF NOT ('S' in switches) THEN  scrn_update(title='Include');
  222.       while ( NOT EOLN (fv) ) AND ( NOT EOF (fv) ) DO
  223.       BEGIN
  224.          IF keypressed THEN dealwithuser;
  225.          read ( fv , f);
  226.          case scan of
  227.             none:   Start_Parsing ;
  228.             symbol: Symbol_Parsing ;
  229.             quote:  BEGIN
  230.                        Add_Line_Ch ( Line , f ) ;
  231.                        IF f = '''' THEN scan := none ;
  232.                     END;
  233.             com1:   Com1_Parsing ;
  234.             pcom2:  Pcom2_Parsing ;
  235.             com2:   Com2_Parsing ;
  236.             pcom2x: BEGIN
  237.                        Add_Line_Ch ( Line , f ) ;
  238.                        IF (f = ')') THEN scan := none
  239.                        ELSE BEGIN
  240.                                scan := com2;
  241.                                lastf:=f
  242.                             END
  243.                     END;
  244.          END ; (* CASE *)
  245.       END ; (* NOT END OF LINE *)
  246.       IF scan = symbol THEN
  247.       BEGIN
  248.          WRITEid;
  249.          scan := none
  250.       END;
  251.       New_Line ( fv , File_Name , Title , Line , Line_Numb ) ;
  252.       readln (  fv ) ;
  253.    END ; (* NOT EOF *)
  254.    CLOSE ( Fv ) ;
  255. END;
  256.  
  257.