home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / zen / zindent / zindsk.inc < prev    next >
Encoding:
Text File  |  1987-03-30  |  9.8 KB  |  356 lines
  1.  
  2. (***************************************************************)
  3. (*                                                             *)
  4. (* Include File of Procedures                                  *)
  5. (* System Disk Utility,  v. 0830am, sun, 28.Mar.87, Glen Ellis *)
  6. (*                                                             *)
  7. (***************************************************************)
  8.  
  9.  
  10. (* procedure *******************************************************)
  11. (* Say File List,     v. 0126pm, mon, 01.Sept.86, Glen Ellis       *)
  12.  
  13. procedure pSayFileList;
  14.  
  15. (* display list of filenames from Text File input *)
  16. begin
  17.    writeln;
  18.    FOR x := 1 to SysInSourceMax do
  19.    begin
  20.       writeln('SysInSource[',x,'] = ', SysInSource[x] );
  21.    end;
  22.    writeln;
  23. end;
  24.  
  25.  
  26. (* procedure **************************************************)
  27. (* System Parse .inc, v. 0700pm, mon, 15.Dec.86, Glen Ellis   *)
  28.  
  29. procedure pSysParse( parseFile : Thestr ; var PgmMod : string2 ;
  30. var PgmModStrL, PgmModStrR : string2 );
  31.  
  32. (* SysInFilename contains the real SourceFileName *)
  33. (* parse for ?TYP
  34. (*   OutLine(.TXT) /  dBASE(.CMD.PRG) / Pascal(.PAS.INC.PRO.FUN)
  35. (* default to .$$$ (which is written normally any way)
  36. (* set SysMode flag to ('  ') or (OL) or (TP) or (DB)
  37. (*---------------------------------------------------------*)
  38.  
  39. (* parseFile    = parseFileName to be parsed for .TYP mode
  40. (* Mode     = flag for system use
  41. (* ModStrL  = prefix for comment line
  42. (* ModStrR  = Suffix for comment line
  43. *)
  44.  
  45. var
  46. i  : nbr;
  47. uTYPArray : array[0..12] of string4;
  48. uTYPe     : string4;
  49. uLine     : THEstr;
  50.  
  51. begin (* proc *)
  52.  
  53.    uType := '    ';
  54.  
  55.    (* enter only if SysPgmMod is '  ' *)
  56.    (* pgmMod   := '  '; *)
  57.  
  58.    PgmModStrL  := '  ';
  59.    PgmModStrR  := '  ';
  60.  
  61.    (* OutLine *)
  62.    uTYPArray[0] := '.TXT';
  63.  
  64.    (* dBASE *)
  65.    uTYPArray[1] := '.CMD';
  66.    uTYPArray[2] := '.PRG';
  67.  
  68.    (* Turbo Pascal *)
  69.    uTYPArray[3] := '.PAS';
  70.    uTYPArray[4] := '.INC';
  71.    uTYPArray[5] := '.FUN';
  72.    uTYPArray[6] := '.PRO';
  73.    uTYPArray[7] := '.BOX';
  74.  
  75.    (* ZinLine,ZinFile, and ZinUser also trap for this error. *)
  76.    IF length(parseFile) = 0 then
  77.    begin
  78.       writeln('No FileName Entered');
  79.       pAlarm;
  80.       pKeyPressed;
  81.    end;
  82.  
  83.    (*-------------------*)
  84.  
  85.    pAllCaps(parseFile);    (* prep for parse for filename *)
  86.  
  87.    x  := pos('.',parseFile);
  88.  
  89.    IF x < 1 then   (* emergency trap *)
  90.    begin
  91.       parseFile := '.###';
  92.       x := 1;
  93.    end;
  94.  
  95.    uTYPe := copy(parseFile,x,4);
  96.  
  97.    uLine := uTYPe;
  98.    pAllCaps(uLine);
  99.  
  100.    (*------*)
  101.    (* OutLine , general catch-all *)
  102.    (* KeyWord parser procedure has not neen written for OutLine. *)
  103.    (* potential use is for Assembler Source Code.  *)
  104.  
  105. (* for x :=  y to z  do  *)
  106.    begin
  107.       IF uTYPe =  uTYPArray[0] then
  108.       (* there is no key.inc module for this. User can write one *)
  109.       begin
  110.          PgmMod := 'OL';
  111.          PgmModStrL  := '; ';  (* comment delimiters *)
  112.          PgmModStrR  := ' ;';
  113.       end;
  114.    end;
  115.  
  116.  
  117.    for x := 1 to 2 do
  118.    begin
  119.       (* dBASE *)
  120.       IF uTYPe =  uTYPArray[x] then
  121.       begin
  122.          PgmMod := 'DB';
  123.          PgmModStrL  := '* ';  (* comment delimiters *)
  124.          PgmModStrR  := ' *';
  125.       end;
  126.    end;
  127.  
  128.    (* Turbo Pascal *)
  129.    for x := 3 to 7 do
  130.    begin
  131.       IF uTYPe =  uTYPArray[x] then
  132.       begin
  133.          PgmMod := 'TP';
  134.          PgmModStrL := '(*';   (* comment delimiters *)
  135.          PgmModStrR := '*)';
  136.       end;
  137.    end;
  138.  
  139. end; (* proc *)
  140.  
  141.  
  142. (* procedure ************************************************************)
  143. (* Input/Output Error Checking, v. 0700pm, sun, 21.Sept.86, Glen Ellis  *)
  144.  
  145. procedure pIOCheck( var IOcheck : lgc );
  146.  
  147. (* develop no halt for trying to read non-existent file *)
  148. (* need skip read loop, continue program if no file found *)
  149.  
  150. var
  151. Ch : Char;
  152. IOReadErr : lgc;
  153.  
  154. begin (* proc *)
  155.  
  156.    IOVal := IOresult;
  157.    IOErr := (IOVal <> 0);
  158.  
  159.    (* GotoXY(1,23); ClrEol; *)
  160.  
  161.    IF IOErr then
  162.    begin
  163.  
  164.       Write(Chr(7));
  165.       writeln('---------------------------');
  166.       writeln('       I/O    Error        ');
  167.       writeln('---------------------------');
  168.  
  169.       (*    pAlarm; (* SysUtl.inc *)
  170.  
  171.       CASE IOVal of
  172.  
  173.          $01  :  Write('  File does not exist');
  174.          $02  :  Write('  File not open for input');
  175.          $03  :  Write('  File not open for output');
  176.          $04  :  Write('  File not open');
  177.          $05  :  Write('  Can''t read from this file');
  178.          $06  :  Write('  Can''t write to this file');
  179.          $10  :  Write('  Error in numeric format');
  180.          $20  :  Write('  Operation not allowed on a logical device');
  181.          $21  :  Write('  Not allowed in direct mode');
  182.          $22  :  Write('  Assign to standard files not allowed');
  183.          $90  :  Write('  Record length mismatch');
  184.          $91  :  Write('  Seek beyond end of file');
  185.          $96  :  Write('  Strange undefined IO error, not in manual !');
  186.          $99  :  Write('  Unexpected end of file');
  187.          $F0  :  Write('  Disk write error');
  188.          $F1  :  Write('  Directory is full');
  189.          $F2  :  Write('  File size overflow');
  190.          $FF  :  Write('  File disappeared')
  191.          else    Write('  Unknown I/O error:  ',IOVal:3)
  192.       end; (* case *)
  193.  
  194.       writeln;
  195.  
  196.       (* if no read file, then skip whole "core" loop *)
  197.       (* this is probably NOT a FATAL error.          *)
  198.  
  199.       IF IOval = $01 then
  200.       begin
  201.          (* IOcheck is tested/prompted in main program *)
  202.          IOcheck := false ;
  203.          IF SysPgmTrace then
  204.          begin
  205.             (* inform the user, and keep going *)
  206.             writeln('  IOcheck = ',IOcheck,' : IOval = ',IOval,chr(7));
  207.             pDelay4;
  208.          end;
  209.       end;
  210.  
  211.       (* other errors May Be Fatal, so allow user to exit *)
  212.  
  213.       IF IOval > $01 then  (**)
  214.       begin
  215.  
  216.                Repeat
  217.                   Read(Kbd,Ch)
  218.                Until Not KeyPressed;
  219.  
  220.                writeln('  User Interrupt allowed ');
  221.                Write(^M,'  Terminate (Y/N)? ');
  222.                Read(Kbd,Ch);
  223.  
  224.                IF UpCase(Ch)='Y' Then
  225.                begin
  226.                   WriteLn('Y');
  227.                   (* Write(SysOutFile,'  User Terminated on pIOcheck error');*)
  228.                   Close(SysOutFile);
  229.                   Close(SysInFile);
  230.                   Halt;
  231.                end
  232.                Else Write(^M,'                ',^M);
  233.  
  234.       end; (* IOval *)
  235.    end; (* IOerr *)
  236. end; (* proc *)
  237.  
  238.  
  239. (* procedure ****************************************************)
  240. (* Start System Files,   v. 0752pm, thu, 18.Sep.86, Glen Ellis *)
  241.  
  242. procedure pSysStartFiles( var IOcheck : lgc );
  243.  
  244. (* borrows system global vars *)
  245. (* SysFile 0,1,2, SysIOcheck flag*)
  246.  
  247. var
  248. x : integer;
  249.  
  250. begin (* proc *)
  251.  
  252.    (* position of .typ *)
  253.    x := pos('.',SysInFileName);
  254.  
  255.    (* file.BAK *)
  256.    SysFile0 := copy(SysInFileName,1,x);
  257.    SysFile0 := concat(SysFile0,'BAK');
  258.  
  259.    (* file.CMD *)
  260.    SysFile1 := SysInFileName;
  261.  
  262.    (* file.$$$ *)
  263.    SysFile2 := copy(SysInFileName,1,x);
  264.    SysFile2 := concat(SysFile2,'$$$');
  265.  
  266.    IF SysUserTrace then
  267.    begin
  268.       pSaySysFiles;   (* SysUtl.inc *)
  269.       IF SysPgmTrace then pDelay1;
  270.    end;
  271.  
  272.    IF SysUserTrace then writeln('  Assign Read-File  = ',SysFile1);
  273.    ASSIGN( SysInFile, SysFile1 );
  274.  
  275.    IF SysUserTrace then writeln('  Reset   Read      = ',SysFile1);
  276.    (*$I-*); RESET( SysInFile ); (*$I+*);
  277.    pIOcheck( IOcheck );
  278.  
  279.    IF IOcheck  then (* able to read from Source file *)
  280.    begin
  281.  
  282.       IF SysUserTrace then writeln('  Assign Write-File = ',SysFile2);
  283.       ASSIGN( SysOutFile, SysFile2 );
  284.  
  285.       IF SysUserTrace then writeln('  ReWrite  Write    = ',SysFile2);
  286.       (*$I-*); REWRITE( SysOutFile ); (*$I+*);
  287.       pIOcheck( IOcheck );
  288.  
  289.    end; (* IOcheck *)
  290.  
  291. end; (* proc *)
  292.  
  293.  
  294.  
  295. (* Procedure *********************************************************)
  296. (* Rename System Files,  v. 0830pm, wed, 17.Sep.86, Glen Ellis *)
  297.  
  298. procedure pSysReName( var IOcheck : lgc );
  299.  
  300. begin (* proc *)
  301.  
  302.    (* borrows system global vars *)
  303.  
  304.    (* purpose:
  305.    (* rename the outfile.$$$ to Sourcefile.CMD
  306.    (* so operation of program is invisible to user
  307.  
  308.    (* test for infile.bak prior to erase/rename
  309.  
  310.    (* SysFile0 is Source.BAK *)
  311.    (* SysFile1 is Source.CMD *)
  312.    (* SysFile2 is Source.$$$ *)
  313.  
  314.    IF SysUserTrace then writeln('  --- Rename Files ---');
  315.  
  316.    ASSIGN( SysInfile, SysFile0 ); (* test for presence of file.BAK *)
  317.    (*$I-*); RESET( SysInFile ); (*$I+*);
  318.    pIOcheck( IOcheck );
  319.    (* if not file.BAK, then simply continue *)
  320.    
  321.    (* handled by pIOcheck() *);
  322.    (* IOval   := IOresult ; *)
  323.    (* IOerr   := (IOval <> 0); *)
  324.    
  325.    IF not IOerr then
  326.    begin
  327.       IF SysUserTrace then writeln('  --- Erase ',SysFile0,' ---');
  328.       (*$I-*); ERASE( SysInFile ); (*$I+*);
  329.       pIOcheck( IOcheck );
  330.    end;
  331.    
  332.    IF SysUserTrace then
  333.    writeln('  --- Rename ',SysFile1, ' to ',SysFile0,' ---');
  334.  
  335.    ASSIGN(SysInFile,SysFile1); (* open Source.CMD *)
  336.    (*$I-*); RENAME( SysInFile, SysFile0 ); (*$I+*);
  337.    (* rename Source.CMD to Source.BAK *)
  338.    (*$I-*); CLOSE( SysInFile ); (*$I+*);
  339.    pIOcheck( IOcheck );  (* close  Source.BAK *)
  340.    
  341.    IF SysUserTrace then
  342.    writeln('  --- Rename ',SysFile2,' to ',SysFile1,' ---');
  343.    
  344.    ASSIGN( SysOutfile, SysFile2 );
  345.    (*$I-*); RENAME( SysOutFile, SysFile1 ); (*$I+*);
  346.    pIOcheck( IOcheck );
  347.    (*$I-*); CLOSE( SysInFile ); (*$I+*);
  348.    pIOcheck( IOcheck );
  349.    (*$I-*); CLOSE( SysOutFile ); (*$I+*);
  350.    pIOcheck( IOcheck );
  351.    
  352.    IF SysUserTrace then writeln('  --- Close Files ---');
  353.  
  354. end; (* proc *)
  355.  
  356. (*---------------------------------------------------------*)
  357. (*<<<>>>*)