home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / ME494-3.ZIP / PASCAL.SRC < prev    next >
Encoding:
Text File  |  1990-05-28  |  14.2 KB  |  669 lines
  1. $MACRO_FILE PASCAL;
  2. {******************************************************************************
  3.                                                         MULTI-EDIT MACRO FILE
  4.  
  5. Name: PASCAL
  6.  
  7. Description:    Language support for Pascal
  8.  
  9. PAS_IND - Smart indent
  10. PASTEMP - Template editing
  11. PASMTCH - Construct matching
  12.  
  13.                (C) Copyright 1989 by American Cybernetics, Inc.
  14. ******************************************************************************}
  15.  
  16. $MACRO PASMTCH TRANS;
  17. {******************************************************************************
  18.                                 MULTI-EDIT MACRO
  19.  
  20. Name: PASMTCH
  21.  
  22. Description:  This macro will match occurances of BEGIN/END, (), CASE/END
  23.   and handles problems withc statements embedded in quotes or comments.
  24.  
  25.                (C) Copyright 1989 by American Cybernetics, Inc.
  26. ******************************************************************************}
  27.  
  28.     DEF_STR( Str1, Str2, Str3,     {Match strings}
  29.                      T_Str,S_str, FStr );
  30.  
  31.     DEF_INT( Direction,   {1 = search forward, 0 = backward}
  32.                      B_Count,     {Match count.  0 = match found}
  33.                      S_Res,       {Search result}
  34.                      Second_Time );
  35.  
  36.  
  37.     Second_Time := False;
  38.     Refresh := False;     {Turn screen refresh off}
  39.     Str3 := '';           {Some matchs only require 2 match strings so init the 3rd}
  40.  
  41. Find_Match_Str:
  42.  
  43.     IF (Cur_Char = '(') THEN   {Setup match for '('}
  44.         Str1 := '(';
  45.         Str2 := ')';
  46.         Direction := 1;
  47.         S_Str := Str1+'||'+Str2+'||[''{}]||{(@*}||{@*)}';
  48.         GOTO Start_Match;
  49.     END;
  50.  
  51.     IF (Cur_Char = ')') THEN   {Setup match for ')'}
  52.         Str1 := ')';
  53.         Str2 := '(';
  54.         Direction := 0;
  55.         S_Str := Str1+'||'+Str2+'||[''{}]||{(@*}||{@*)}';
  56.         GOTO Start_Match;
  57.     END;
  58.  
  59.  
  60.     IF At_EOL THEN     {If we are at the end of a line the go to the first word}
  61.         First_Word;
  62.     END;
  63.  
  64.     IF (Cur_Char = ' ') or
  65.          (Cur_Char = '|9') or
  66.          (Cur_Char = '|255') THEN      {If we are on a blank space then find a word}
  67.         Word_Right;
  68.     END;
  69.  
  70.     T_Str := Caps( Get_Word(';. |9|255') );  {Get the current word}
  71.  
  72.     IF (T_Str = 'BEGIN') OR (T_Str = 'CASE') THEN
  73.         Str1 := 'BEGIN';
  74.         Str2 := 'END';
  75.         Str3 := 'CASE';
  76.         Direction := 1;
  77.         S_Str := '{%||[|9 ;}]{'+Str1+'}||{'+Str2+'}||{'+Str3+'}$||[ |9;.{]}||[''{}]||{(@*}||{@*)}';
  78.         GOTO Start_Match;
  79.     END;
  80.  
  81.     IF T_Str = 'END' THEN
  82.         Str1 := 'END';
  83.         Str2 := 'BEGIN';
  84.         Str3 := 'CASE';
  85.         Direction := 0;
  86.         Word_Left;
  87.         Left;
  88.         S_Str := '{%||[|9 ;}]{'+Str1+'}||{'+Str2+'}||{'+Str3+'}$||[|9 ;.{]}||[''{}]||{(@*}||{@*)}';
  89.         GOTO Start_Match;
  90.     END;
  91.  
  92.     {If we didn't find a word to match the first time then try again}
  93.     If NOT( Second_Time ) THEN
  94.         Second_Time := True;
  95.         First_Word;
  96.         GOTO Find_Match_Str;
  97.     END;
  98.  
  99.     Make_Message('NOTHING to Match');
  100.     GOTO Macro_Exit;
  101.  
  102. Start_Match:
  103.     Reg_Exp_Stat := True;
  104.     Ignore_Case := True;
  105.     B_Count := 1;
  106.     S_Res := 1;
  107.     Make_Message('Matching...  Press <ESC> to Stop.');
  108.     Working;
  109.  
  110. MATCH_LOOP:   {Main loop}
  111.  
  112.                     {If the <ESC> key is pressed while matching then abort the search}
  113.     if check_key then
  114.         if key1 = 27 then
  115.             Make_Message('Match Aborted.');
  116.             goto macro_exit;
  117.         end;
  118.     end;
  119.  
  120.     If S_Res = 0 THEN   {If last search result was false then exit}
  121.         GOTO Error_Exit;
  122.     END;
  123.  
  124.     If B_Count = 0 THEN {If match count is 0 then success}
  125.         GOTO Found_Exit;
  126.     END;
  127.  
  128.     If Direction = 1 THEN {Perform search based on direction}
  129.         Right;
  130.         While NOT( At_EOL) and (Cur_CHar = '|255') DO
  131.             Right;
  132.         END;
  133.         S_Res := Search_Fwd(S_Str,0);
  134.     ELSE
  135.         Left;
  136.         While (Cur_CHar = '|255') or
  137.                     (Cur_Char = '|9') DO
  138.             Left;
  139.         END;
  140.         S_Res := Search_Bwd(S_Str,0);
  141.     END;
  142.  
  143.     If S_Res = 0 THEN   {If search failed then exit}
  144.         GOTO Macro_Exit;
  145.     END;
  146.  
  147.  
  148.     FStr := Caps(Found_Str); {Get the found string and capatilize it}
  149.     IF XPOS(Copy(FStr,1,1),'|9 ;',1)  THEN  {If the first char is a space or a ;}
  150.         FStr := Copy(FStr,2,20);         {  then eliminate it}
  151.     END;
  152.                                                                          {If it ended in a space, ; or . then}
  153.     IF XPOS(Copy(FStr,Length(FStr),1),'|9 ;.',1) THEN
  154.         FStr := Copy(FStr,1,Length(FStr) - 1);  {eliminate that char}
  155.     END;
  156.  {    Make_Message(FStr);
  157.     read_key; }
  158.  
  159.                                                             {If we found the first match string then}
  160.     IF FStr = STR1 THEN
  161.         B_Count := B_Count + 1;   {Inc the match count}
  162.         GOTO Match_Loop;
  163.     END;
  164.  
  165.     IF FStr = STR2 THEN          {If we found the second match string then}
  166.         B_Count := B_Count - 1;    {  decrement the match count}
  167.         GOTO Match_Loop;
  168.     END;
  169.  
  170.     If FStr = '''''' THEN        {If we found two single quotes the skip it}
  171.         If Direction = 1 THEN
  172.             RIGHT;
  173.         ELSE
  174.             LEFT;
  175.         END;
  176.         GOTO Match_Loop;
  177.     END;
  178.  
  179.  
  180.                                                             {If we found a single quote then match it}
  181.     IF FStr = '''' THEN
  182.  
  183.         Quote_Loop:
  184.  
  185.             If Direction = 1 THEN
  186.                 RIGHT;
  187.             ELSE
  188.                 LEFT;
  189.             END;
  190.             IF Direction = 1 THEN
  191.                 S_Res := Search_Fwd('''',0);
  192.             ELSE
  193.                 S_Res := Search_Bwd('''',0);
  194.             END;
  195.             If S_Res = 0 THEN
  196.                 GOTO Macro_Exit;
  197.             END;
  198.             FStr := Found_Str;
  199.             If FStr = '''''' THEN
  200.                 GOTO Quote_Loop;
  201.             END;
  202.             GOTO Match_Loop;
  203.  
  204.     END;
  205.  
  206.                                                         {If we found a comment then match it}
  207.     IF (Direction = 1) AND (FStr = '{') THEN
  208.             S_Res := Search_Fwd('@}',0);
  209.             GOTO Match_Loop;
  210.     END;
  211.                                                         {If we found a comment then match it}
  212.     IF (Direction = 0) AND (FStr = '}') THEN
  213.             S_Res := Search_Bwd('@{',0);
  214.             GOTO Match_Loop;
  215.     END;
  216.                                                         {If we found a comment then match it}
  217.     IF (Direction = 1) AND (FStr = '(*') THEN
  218.             S_Res := Search_Fwd('@*)',0);
  219.             GOTO Match_Loop;
  220.     END;
  221.                                                         {If we found a comment then match it}
  222.     IF (Direction = 0) AND (FStr = '*)') THEN
  223.             S_Res := Search_Bwd('(@*',0);
  224.             GOTO Match_Loop;
  225.     END;
  226.                                                         {If we found the third string then}
  227.                                                         {  if forward search then}
  228.     IF (Direction = 0) and (FStr = Str3) THEN
  229.         B_Count := B_Count - 1; {  decrement the match count}
  230.         GOTO Match_Loop;
  231.     END;                      {  if backward search then}
  232.     If (Direction = 1) and (FStr = Str3) THEN
  233.         B_Count := B_Count + 1; {  increment the match count}
  234.         GOTO Match_Loop;
  235.     END;
  236.  
  237. Error_Exit:     {Go here for unsucessfull match}
  238.     Make_Message('Match NOT Found');
  239.     GOTO Macro_Exit;
  240.  
  241. Found_Exit:     {Go here for successfull match}
  242.     Make_Message('Match Found');
  243. Macro_Exit:
  244.     Refresh := True;
  245.     Redraw;
  246. END_MACRO;
  247.  
  248. $MACRO PAS_IND;
  249. {******************************************************************************
  250.                                 MULTI-EDIT MACRO
  251.  
  252. Name: PAS_IND
  253.  
  254. Description:  This macro will perform a smart indent when the <ENTER> key is
  255.   pressed.  This macro is called by the macro CR.
  256.  
  257.                (C) Copyright 1989 by American Cybernetics, Inc.
  258. ******************************************************************************}
  259.  
  260.     DEF_STR(C_STR);          {Word to check for indent}
  261.     DEF_INT(T_COL,T_COL2);   {Temp column positions}
  262.     DEF_INT(sig_char_found,ind_count,jx);
  263.     DEF_CHAR(found_char);
  264.     Messages := False;
  265.  
  266.     MARK_POS;
  267.     Reg_Exp_Stat := True;
  268.     Down;
  269.     Refresh := False;
  270.     Up;
  271.     LEFT;
  272.     {Check to see if we are inside a comment}
  273.     {Don't go back farther than 5 lines in order to improve speed}
  274.  
  275.     IF Search_Bwd('@{||@}||{(@*}||{@*)}',5) THEN
  276.         IF (Cur_Char = '{') or (Cur_Char = '(') THEN
  277.             IF (Cur_Char = '{') THEN
  278.                 RIGHT;
  279.             ELSE
  280.                 RIGHT;
  281.                 RIGHT;
  282.             END;
  283.             Set_Indent_Level;
  284.             GOTO_MARK;
  285.         {    Refresh := True; }
  286.             CR;
  287.             GOTO MAC_EXIT;
  288.         END;
  289.     END;
  290.  
  291.  
  292.     GOTO_MARK;
  293.  
  294.     MARK_POS;
  295.  
  296.     CALL SKIP_PAS_NOISE1;
  297.     FOUND_CHAR := CUR_CHAR;
  298.     GOTO_MARK;
  299.  {REFRESH := TRUE;}
  300.  
  301.     T_COL2 := C_COL;         {Store current position}
  302.     FIRST_WORD;              {Go to the first word on the line}
  303.     T_COL := C_COL;          {Store this position}
  304.  
  305.     IF T_COL2 < T_COL THEN   {If this position is greater than the original}
  306.         T_COL := T_COL2;       {  then store the original}
  307.         GOTO_COL(T_COL);       {  and go there}
  308.     END;
  309.     IF At_Eol = False THEN {If we are beyond the end of the line then}
  310.         SET_INDENT_LEVEL;      {  set the indent level}
  311.     END;
  312.  
  313.     T_COL := C_COL;          {Store the current position}
  314.                                                      {Get the current word, removing any extra space}
  315.     C_STR := ' ' + REMOVE_SPACE(CAPS( GET_WORD('; (,{') )) + ' ';
  316.     GOTO_COL(T_COL2);        {Put cursor on original position}
  317.     CR;                      {Perform a carriage return}
  318.  
  319.                                                      {If the word is in this list, and the original
  320.                                                             position was not on the first word then
  321.                                                             indent}
  322.     IF (T_COL <> T_COL2) AND (LENGTH(C_STR) <> 0) AND
  323.         (POS(C_STR,
  324.      ' PROCEDURE FUNCTION BEGIN '
  325.      ) <> 0) THEN
  326.             INDENT;
  327.     ELSE
  328.         IF (Found_Char <> ';') and (T_COL <> T_COL2) and (LENGTH(C_STR) <> 0)
  329.             AND (POS(C_STR,
  330.         ' VAR TYPE CONST PROCEDURE FUNCTION BEGIN IF WHILE REPEAT WITH FOR ELSE '
  331.         ) <> 0) THEN
  332.             INDENT;
  333.         ELSE
  334.     {*********************************************************************}
  335.     {***>>> IF YOU DON'T WANT AN UNDENT AFTER 'END' THEN COMMENT OUT THE  }
  336.     {***>>> FOLLOWING THREE LINES                                         }
  337.             IF (C_STR = ' END ') THEN
  338.                 UNDENT;
  339.             END;
  340.         END;
  341.     END;
  342.     GOTO MAC_EXIT;
  343.  
  344. SKIP_PAS_NOISE1:
  345.  
  346. { Here we look for the nearest preceding nonblank character.  If it is a
  347.     closing comment then we find the  nearest opening comment.
  348. }
  349.  
  350.     IF (SEARCH_BWD('[~ |9]', 1)) THEN
  351.         IF (CUR_CHAR = ')') THEN
  352.             LEFT;
  353.             IF (CUR_CHAR = '*') THEN
  354.                 JX := SEARCH_BWD('(@*', 0);
  355.                 LEFT;
  356.                 GOTO SKIP_PAS_NOISE1;
  357.             END;
  358.             RIGHT;
  359.             SIG_CHAR_FOUND := TRUE;
  360.             GOTO EXIT_SKIP_PAS;
  361.         ELSE
  362.             IF (CUR_CHAR = '}') THEN
  363.                 JX := SEARCH_BWD('@{', 0);
  364.                 LEFT;
  365.                 GOTO SKIP_PAS_NOISE1;
  366.             END;
  367.         END;
  368.  
  369.         SIG_CHAR_FOUND := TRUE;
  370.         GOTO EXIT_SKIP_PAS;
  371.     END;
  372.  
  373. { If we failed to find a nonblank character on the current line, and the
  374.     cursor is on line 1, we failed to find a significant character; otherwise,
  375.     we back up a line and try again. }
  376.  
  377.     IF (C_LINE = 1) THEN
  378.         SIG_CHAR_FOUND := FALSE;
  379.         GOTO EXIT_SKIP_PAS;
  380.     END;
  381.     UP;
  382.     EOL;
  383.     GOTO SKIP_PAS_NOISE1;
  384.  
  385. EXIT_SKIP_PAS:
  386.  {REFRESH := TRUE;}
  387.     RET;
  388.  
  389.  
  390.  
  391. MAC_EXIT:
  392.     REFRESH := True;
  393.     Messages := True;
  394. END_MACRO;
  395.  
  396. $MACRO PASTEMP TRANS;
  397. {******************************************************************************
  398.                                 MULTI-EDIT MACRO
  399.  
  400. Name: PASTEMP
  401.  
  402. Description: Creates pascal language constructs based on a single character
  403.   to the left of the current cursor position.
  404.  
  405.                (C) Copyright 1989 by American Cybernetics, Inc.
  406. ******************************************************************************}
  407.  
  408.     DEF_INT(Temp_Col,Temp_Insert,Choice, UC);
  409.     DEF_STR(XStr);
  410.  
  411.     Temp_Insert := Insert_Mode;
  412.     If (At_Eol = False) Then
  413.         GOTO END_OF_MAC;
  414.     End;
  415.  
  416.     Insert_Mode := True;
  417.     Temp_Col := C_COL;
  418.  
  419.     Left;
  420.  
  421.     If (C_Col > 1) Then
  422.         Left;
  423.         If (Pos(Cur_Char,' ;})Ff|255|9') = 0) Then
  424.             Goto_Col(Temp_Col);
  425.             Goto END_OF_MAC;
  426.         Else
  427.             Right;
  428.         End;
  429.     End;
  430.  
  431.     UC := true;
  432.  
  433.     If (Cur_Char = 'B') Then
  434.         GOTO MAKEBEGIN;
  435.     End;
  436.  
  437.     If (Cur_Char = 'I') Then
  438.         GOTO MAKEIF;
  439.     End;
  440.  
  441.     If (Cur_Char = 'W') Then
  442.         GOTO MAKEWHILE;
  443.     End;
  444.  
  445.     If (Cur_Char = 'R') Then
  446.         GOTO MAKEREPEAT;
  447.     End;
  448.  
  449.     If (Cur_Char = 'O') Then
  450.         Del_Char;
  451.         Temp_Col := Temp_Col - 1;
  452.         GOTO MAKEFOR;
  453.     End;
  454.  
  455.     If (Cur_Char = 'U') Then
  456.         Temp_Col := Temp_Col - 1;
  457.         Del_Char;
  458.         GOTO MAKEFUNCTION;
  459.     End;
  460.  
  461.     If (Cur_Char = 'F') Then
  462.  
  463.         RM('userin^xmenu /L=Select:/B=1/T=1/X=' + str(wherex) + '/Y=' + str(wherey - 2) + 
  464.                 '/M=for-Next do(TE) Function()');
  465.         choice := return_int;
  466.         Make_Message('');
  467.         If (Choice = 2) Then
  468.             GOTO MAKEFUNCTION;
  469.         Else
  470.             GOTO MAKEFOR;
  471.         End;
  472.     End;
  473.  
  474.     If (Cur_Char = 'P') Then
  475.         GOTO MAKEPROCEDURE;
  476.     End;
  477.  
  478.     If (Cur_Char = 'C') Then
  479.         GOTO MAKECASE;
  480.     End;
  481.  
  482.  
  483.     UC := false;
  484.     If (Cur_Char = 'b') Then
  485.         GOTO MAKEBEGIN;
  486.     End;
  487.  
  488.     If (Cur_Char = 'i') Then
  489.         GOTO MAKEIF;
  490.     End;
  491.  
  492.     If (Cur_Char = 'w') Then
  493.         GOTO MAKEWHILE;
  494.     End;
  495.  
  496.     If (Cur_Char = 'r') Then
  497.         GOTO MAKEREPEAT;
  498.     End;
  499.  
  500.     If (Cur_Char = 'o') Then
  501.         Del_Char;
  502.         Temp_Col := Temp_Col - 1;
  503.         GOTO MAKEFOR;
  504.     End;
  505.  
  506.     If (Cur_Char = 'u') Then
  507.         Temp_Col := Temp_Col - 1;
  508.         Del_Char;
  509.         GOTO MAKEFUNCTION;
  510.     End;
  511.  
  512.     If (Cur_Char = 'f') Then
  513.  
  514.         RM('userin^xmenu /L=Select:/B=1/T=1/X=' + str(wherex) + '/Y=' + str(wherey - 2) + 
  515.                 '/M=for-Next do(TE) Function()');
  516.         Choice :=  return_int;
  517.  
  518.         make_message('');
  519.         If (Choice = 2) Then
  520.             GOTO MAKEFUNCTION;
  521.         Else
  522.             GOTO MAKEFOR;
  523.         End;
  524.     End;
  525.  
  526.     If (Cur_Char = 'p') Then
  527.         GOTO MAKEPROCEDURE;
  528.     End;
  529.  
  530.     If (Cur_Char = 'c') Then
  531.         GOTO MAKECASE;
  532.     End;
  533.  
  534.     Goto_Col(Temp_Col);
  535.     GOTO END_OF_MAC;
  536.  
  537. MAKEIF:
  538.     Goto_Col(Temp_Col);
  539.     XStr := 'f () then';
  540.     CALL XTEXT;
  541.     Cr;
  542.     Goto_Col(Temp_Col);
  543.     Indent;
  544.     Up;
  545.     Goto_Col(Temp_Col + 3);
  546.     GOTO END_OF_MAC;
  547.  
  548. MAKEWHILE:
  549.     Goto_Col(Temp_Col);
  550.     XSTR := 'hile () Do';
  551.     CALL XTEXT;
  552.     Cr;
  553.     Goto_Col(Temp_Col);
  554.     Indent;
  555.     Up;
  556.     Goto_Col(Temp_Col + 6);
  557.     GOTO END_OF_MAC;
  558.  
  559. MAKEBEGIN:
  560.     Goto_Col(Temp_Col);
  561.     XStr := 'egin';
  562.     CALL XTEXT;
  563.     First_Word;
  564.     Temp_Col := C_Col;
  565.     Eol;
  566.     Cr;
  567.     Cr;
  568.     Goto_Col(Temp_Col);
  569.     XStr := 'end;';
  570.     CALL XTEXT;
  571.     Up;
  572.     Goto_Col(Temp_Col);
  573.     Indent;
  574.     GOTO END_OF_MAC;
  575.  
  576. MAKEFOR:
  577.     Goto_Col(Temp_Col);
  578.     XStr := 'or  :=  to  do';
  579.     CALL XTEXT;
  580.     Cr;
  581.     Goto_Col(Temp_Col);
  582.     Indent;
  583.     Up;
  584.     Goto_Col(Temp_Col + 4);
  585.     GOTO END_OF_MAC;
  586.  
  587. MAKEREPEAT:
  588.     Goto_Col(Temp_Col);
  589.     XStr := 'epeat';
  590.     CALL XTEXT;
  591.     Cr;
  592.     Goto_Col(Temp_Col - 1);
  593.     Indent;
  594.     Cr;
  595.     Goto_Col(Temp_Col - 1);
  596.     XStr := 'until ();';
  597.     CALL XTEXT;
  598.     Goto_Col(Temp_Col + 6);
  599.     GOTO END_OF_MAC;
  600.  
  601. MAKEPROCEDURE:
  602.     Goto_Col(Temp_Col);
  603.     XStr := 'rocedure  ;';
  604.     CALL XTEXT;
  605.     Cr;
  606.     Goto_Col(Temp_Col - 1);
  607.     Indent;
  608.     XStr := 'begin';
  609.     CALL XTEXT;
  610.     Cr;
  611.     Cr;
  612.     XStr := 'end;';
  613.     CALL XTEXT;
  614.     Up;
  615.     Goto_Col(Temp_Col);
  616.     Indent;
  617.     Up;
  618.     Up;
  619.     Goto_Col(Temp_Col + 9);
  620.     GOTO END_OF_MAC;
  621.  
  622. MAKEFUNCTION:
  623.     Goto_Col(Temp_Col);
  624.     XStr := 'unction  ;';
  625.     CALL XTEXT;
  626.     Cr;
  627.     Goto_Col(Temp_Col - 1);
  628.     Indent;
  629.     XStr := 'begin';
  630.     CALL XTEXT;
  631.     Cr;
  632.     Cr;
  633.     XStr := 'end;';
  634.     CALL XTEXT;
  635.     Up;
  636.     Goto_Col(Temp_Col);
  637.     Indent;
  638.     Up;
  639.     Up;
  640.     Goto_Col(Temp_Col + 8);
  641.     GOTO END_OF_MAC;
  642.  
  643. MAKECASE:
  644.     Goto_Col(Temp_Col);
  645.     XStr := 'ase () of';
  646.     CALL XTEXT;
  647.     Cr;
  648.     Cr;
  649.     Goto_Col(Temp_Col - 1);
  650.     XStr := 'end;';
  651.     CALL XTEXT;
  652.     Up;
  653.     Goto_Col(Temp_Col - 1);
  654.     Indent;
  655.     Up;
  656.     Goto_Col(Temp_Col + 5);
  657.     GOTO END_OF_MAC;
  658.  
  659. XTEXT:
  660.     IF UC THEN
  661.         XSTR := CAPS(XSTR);
  662.     END;
  663.     TEXT( XSTR );
  664.     RET;
  665.  
  666. END_OF_MAC:
  667.     Insert_Mode := Temp_Insert;
  668.  
  669. END_MACRO;