home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / zen / zindent / zinkeytp.inc < prev    next >
Encoding:
Text File  |  1987-03-30  |  6.6 KB  |  260 lines
  1.  
  2. (****************************************************************)
  3. (* Include File                                                 *)
  4. (* KeyWord Turbo Pascal  v. 0600pm, wed, 25.Mar.87, Glen Ellis  *)
  5. (****************************************************************)
  6.  
  7. (* called by :
  8. (*             pKEYTP( SOLL, SIP, SIN, SLM, SMW, SEB,SLB
  9. (*
  10. (*  parameters sent:
  11. (*
  12. (*   (SysOutLine, SysIndentPos, SysIndentNum , SysLenMax, SysMarkWrite );
  13. (*    SOLL        SIP           SIN            SLM        SMW
  14. (*
  15. (*   System Enable Begin flag
  16. (*   SEB
  17. (*
  18. (*   Begin/End counter :
  19. (*     SLB
  20. (*
  21. (*   procedure pINDENT() is located in ZinSTR.inc
  22. (*
  23. (* *)
  24.  
  25. (*---------------------------------------------------------------------------*)
  26. procedure pKEYTP( var KLine : THEstr ; var KIPos : nbr ; KINum , KLenMax : nbr;
  27.   var KMwrite, KEB : lgc ; var KLB : nbr);
  28.  
  29.   (* also, uses SysComment
  30.   (*
  31.   (* requires STRING.INC library of string functions
  32.   (* all are var in order to allow sending back altered values
  33.   (* kLINE  := OutLine
  34.   (* kIPOS := indentpos = current indent position
  35.   (* kINUM := indentnum = length of indent group
  36.   (* KMwrite := KMwrite = controls write to disk
  37.   (* *)
  38.  
  39.   var
  40.        (* local memvars *)
  41.        trimcnt : nbr;
  42.        leftmgn  : nbr;
  43.        wkLINE : THEstr;
  44.        KMark : lgc;
  45.        x,y,z   : nbr;
  46.  
  47.        PosHead : lgc;
  48.        PosBegin, PosCase, PosRepeat, PosRecord : nbr;
  49.        PosEnd  : nbr;
  50.  
  51. (*========================================================*)
  52.  
  53. begin  (* Proc *)
  54.    
  55.    trimcnt := 0;
  56.    leftmgn := 0;
  57.    
  58.    (*--- Trim Right Spaces,  We Will Not Pad-Right. *)
  59.    (*--- Trim Left Spaces, Count Them, Prep for Margin adjusted Pad-Left *)
  60.    pTrimLCntR(kLINE,trimcnt);(**)
  61.    (* trimcnt used by KEB controller *)
  62.    
  63.    (*--- Vertical Blank Filler *)
  64.    IF (SysVertiate)
  65.       and (length(kLine) = 0)
  66.       and (KEB)
  67.       then kLine := '(**)';
  68.    (*
  69.    (* this filler group looks cluttered,
  70.    (* and was selected as a compromise,
  71.    (* because Pascal does not tolerate the semi-colon
  72.    (* as a vertical filler between functions and procedures !
  73.    (* *)
  74.    
  75.    (*--- Create Working Line *)
  76.    wkLINE := kLINE;
  77.    
  78.    (*--- Init *)
  79.    KMark := false;
  80.    KMwrite := true;
  81.    
  82.    (*--- convert working line to all caps *)
  83.    (* pAllCaps(wkLINE); (**)
  84.    pUpCaseFirst(wKLine); (**)
  85.    
  86.    
  87.    (*--- check for pos() of pKEYWORDs *)
  88.    
  89.  
  90.    (* optional function.
  91.    (*---------------------------------------------------
  92.    (* detect first occurence of 'begin', then set flag
  93.    (* this delaying tactic protects the title/header area.
  94.    (**)
  95.    
  96.    IF not KEB   (* not started YET ! *)
  97.    then
  98.    begin
  99.       IF (pos('BEGIN',wkLINE)=1)  (* time to Start , NOW ! *)
  100.       then
  101.       begin
  102.          TrimCnt := 0;
  103.          KEB := true; (* start normal indent now ! *)
  104.          (*   will not pass  through here again ! *)
  105.       end;
  106.       (* hold on to the current trim left margin counter *)
  107.       KIPOS := trimcnt;
  108.    end;
  109.    
  110.    
  111.    (*-------------- Key Enable Begin --------------------*)
  112.    IF KEB then  (*  then enable line parse routines *)
  113.    begin
  114.  
  115.       (*---------*)
  116.       (* Comment *)
  117.  
  118.       IF ( pos('{',wkLINE) = 1 )
  119.          or ( pos('(*',wkLINE) = 1 )
  120.          or ( pos(';',wkLINE) = 1 )
  121.          or (length(wkLINE)=0)
  122.       then
  123.       begin
  124.          IF SysComment
  125.             then pINDENT(kLINE,kIPOS,kLenMax)
  126.          ELSE KMwrite := false;
  127.          KMark := true;
  128.       end;
  129.  
  130.  
  131.       (*-------< Allow following module to detect keywords >-------*)
  132.  
  133.       (* I forgot to parse for 'RECORD' right through version #5 ! *)
  134.       (* Thanks to David Beard, Memphis, Tn, a REAL Programmer ! *)
  135.  
  136.       (*------------------------------------------------*)
  137.       (* handle  BEGIN / CASE / REPEAT / RECORD  head.  *)
  138.  
  139.       PosBegin  := pos('BEGIN',  wkLINE);
  140.       PosCase   := pos('CASE',   wkLINE);
  141.       PosRepeat := pos('REPEAT', wkLINE);
  142.       PosRecord := pos('RECORD', wkLINE);
  143.  
  144.       PosHead := false;
  145.  
  146.       IF
  147.       (
  148.       (posBEGIN=1)
  149.       and
  150.       ( (pos('BEGIN ',wkLINE)=1) or (length(wkLINE) = PosBEGIN + 4) )
  151.       )
  152.          then PosHead := true;
  153.  
  154.       IF
  155.       (
  156.       (posCASE=1)
  157.       and
  158.       ( (pos('CASE ',wkLINE)=1) or (length(wkLINE) = PosCASE + 3) )
  159.       )
  160.          then PosHead := true;
  161.  
  162.       IF
  163.       (
  164.       (posREPEAT=1)
  165.       and
  166.       ( (pos('REPEAT ',wkLINE)=1) or (length(wkLINE) = PosREPEAT + 5) )
  167.       )
  168.          then PosHead := true;
  169.  
  170.       IF
  171.       (
  172.       (posRECORD=1)
  173.       and
  174.       ( (pos('RECORD ',wkLINE)=1) or (length(wkLINE) = PosRECORD + 5) )
  175.       )
  176.          then PosHead := true;
  177.  
  178.       IF PosHead then
  179.       begin
  180.          pINDENT(kLINE,kIPOS,kLenMax);
  181.          kIPOS := kIPOS + kINUM;
  182.          KLB := KLB + 1; (* Begin/End counter *)
  183.          KMark := true;
  184.          KEB := true;
  185.       end;
  186.  
  187.  
  188.  
  189.       (*------------------*)
  190.       (* handle 'IF' tail.*)
  191.  
  192.       IF (pos('THEN ',wkLINE)=1)
  193.          or (pos('DO ' ,wkLine)=1)
  194.          or (pos('AND ',wkLine)=1)
  195.          or (pos('OR ' ,wkLine)=1)
  196.          then  (* temporary Offset *)
  197.       begin
  198.          kIPOS := kIPOS + kINUM;
  199.          pINDENT(kLINE,kIPOS,kLenMax);
  200.          kIPOS := kIPOS - kINUM;
  201.          KMark := true;
  202.       end;
  203.  
  204.  
  205.       (*-------------------------------------*)
  206.       (* handle 'BEGIN' 'CASE' 'RECORD' tail.*)
  207.  
  208.       PosEnd := pos('END',wkLINE);
  209.  
  210.       IF ( PosEnd = 1 )
  211.       and
  212.       (
  213.       (pos('END ;',wkLINE) = 1)
  214.       or
  215.       (pos('END;',wkLINE) = 1)
  216.       or
  217.       (length(wkLINE) = PosEnd + 2)
  218.       )
  219.       then
  220.       begin
  221.          (* KEY line *)
  222.          kIPOS := kIPOS - kINUM; (* Position *)
  223.          pINDENT(kLINE,kIPOS,kLenMax);
  224.          KLB := KLB -1; (* Begin/End counter *)
  225.          KMark := true;
  226.       end;
  227.  
  228.  
  229.       (*----------------------------------------------*)
  230.       (* handle 'REPEAT' tail *)
  231.  
  232.       IF  (pos('UNTIL ',wkLINE)=1)
  233.       then
  234.       begin
  235.          (* KEY line *)
  236.          kIPOS := kIPOS - kINUM; (* Position *)
  237.          pINDENT(kLINE,kIPOS,kLenMax);
  238.          KLB := KLB -1; (* Begin/End counter *)
  239.          KMark := true;
  240.       end;
  241.  
  242.    end; (* KEB *)
  243.    (* bottom of IF 'Key Enable Begin' KEB *)
  244.  
  245.  
  246.    (*-----------------*)
  247.    (*  NONE of ABOVE  *)
  248.  
  249.    IF not(KMark) then
  250.    begin
  251.       IF (pos('(*>*)',wkLine)=1) (* margin move right *)
  252.          then  kIPOS := kIPOS + kINUM;
  253.       (*     normal common line       *)
  254.       (* left pad current kIPOS count *)
  255.       pINDENT(kLINE,kIPOS,kLenMax);
  256.    end;
  257.  
  258. end; (* Proc *)
  259.  
  260. (********************************************************************)
  261. (*<<<>>>*)