home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / ME494-3.ZIP / SRC / DBASE.SRC < prev    next >
Encoding:
Text File  |  1990-04-13  |  17.8 KB  |  901 lines
  1. $MACRO_FILE DBASE;
  2. {******************************************************************************
  3.                                                         MULTI-EDIT MACRO FILE
  4.  
  5. Name: DBASE
  6.  
  7. Description:  Contains language support for DBase style languages.
  8.  
  9. DBAMTCH - Construct matching for DBase
  10. DBA_IND - Smart indenting for DBase
  11. DBATEMP - Template editing for DBase
  12.  
  13.                              (C) Copyright 1989 by American Cybernetics, Inc.
  14. *******************************************************************************}
  15.  
  16. $MACRO DBAMTCH TRANS;
  17. {******************************************************************************
  18.                                                                 MULTI-EDIT MACRO
  19.  
  20.  Name: DBAMTCH
  21.  
  22.  Description:  This macro will match occurances of
  23.          IF / ENDIF, CASE / ENDCASE, DO WHILE / ENDDO, TEXT / ENDTEXT, ( / )
  24.                              (C) Copyright 1989 by American Cybernetics, Inc.
  25.                                                      Contributed by Julius Nadas
  26. ******************************************************************************}
  27.  
  28.     DEF_STR( Str1, Str2, S_var,            {Match strings}
  29.                      Xtr2,
  30.                      T_Str, S_str, FStr );
  31.  
  32.     DEF_INT( Direction,   {1 = search forward, 0 = backward}
  33.                      B_Count,     {Match count.  0 = match found}
  34.                      I_var,       {just a temp variable}
  35.                      temp_case,   {save ignore_case flag}
  36.                      S_Res);      {Search result}
  37.  
  38.     Refresh := False;     {Turn screen refresh off}
  39.     temp_case := ignore_case;
  40.     ignore_case := true;
  41.  
  42.     Mark_Pos;             { return here if no find }
  43.  
  44.     IF (Cur_Char = '(') THEN   {Setup match for '('}
  45.         Str1 := '(';
  46.         Xtr2 := ')';
  47.         Str2 := ')';
  48.         Direction := 1;
  49.         S_Str := '(||)||$';
  50.         GOTO Start_Match;
  51.     END;
  52.  
  53.     IF (Cur_Char = ')') THEN   {Setup match for ')'}
  54.         Str1 := ')';
  55.         Xtr2 := '(';
  56.         Str2 := '(';
  57.         Direction := 0;
  58.         S_Str := Str1+'||'+Str2+'||%';
  59.         GOTO Start_Match;
  60.     END;
  61.  
  62.  {go to the first word}
  63.     goto_col(1);
  64.  
  65. Match_Construct:
  66.  
  67.     IF Cur_Char = ' ' THEN      {If we are on a blank space then find a word}
  68.         Word_Right;
  69.     END;
  70.  
  71.     T_Str := copy( Caps( Get_Word(' ') ),1,4);  {Get the current word}
  72.  
  73.     IF (T_Str = 'ELSE') or (T_Str = 'IF') THEN
  74.         Str1 := 'IF';
  75.         Xtr2 := 'ENDIF';
  76.         Str2 := 'ENDI';
  77.         S_Str := '{% *IF}||{% *ENDI}';
  78.         GOTO Match_Down;
  79.     END;
  80.  
  81.     IF T_Str = 'ENDI' THEN
  82.         Str1 := 'ENDI';
  83.         Xtr2 := 'IF';
  84.         Str2 := 'IF';
  85.         S_Str := '{% *IF}||{% *ENDI}';
  86.         GOTO Match_Up;
  87.     END;
  88.  
  89.     IF (T_Str = 'TEXT') THEN
  90.         Str1 := 'TEXT';
  91.         Xtr2 := 'ENDTEXT';
  92.         Str2 := 'ENDT';
  93.         S_Str := '{% *TEXT}||{% *ENDT}';
  94.         GOTO Match_Down;
  95.     END;
  96.  
  97.     IF T_Str = 'ENDT' THEN
  98.         Str1 := 'ENDT';
  99.         Xtr2 := 'TEXT';
  100.         Str2 := 'TEXT';
  101.         S_Str := '{% *TEXT}||{% *ENDT}';
  102.         GOTO Match_Up;
  103.     END;
  104.  
  105.     IF T_Str = 'DO' THEN
  106.         Word_Right;
  107.         T_Str := copy( Caps( Get_Word(' ') ),1,4);  {Get the current word}
  108.     END;
  109.  
  110.     { check for either a DO WHILE or a simple WHILE or LOOP or EXIT }
  111.     IF (T_Str = 'WHIL') or (T_Str = 'EXIT') or (T_Str = 'LOOP') THEN
  112.         Str1 := 'DO WHIL';
  113.         Xtr2 := 'ENDDO';
  114.         Str2 := 'ENDD';
  115.         S_Str := '{% *DO +WHIL}||{% *ENDD}';
  116.         GOTO Match_Down;
  117.     END;
  118.  
  119.     { check for either a DO CASE or  simple CASE or OTHERWISE }
  120.     IF (T_Str = 'CASE') or (T_str = 'OTHE') THEN
  121.         Str1 := 'DO CASE';
  122.         Xtr2 := 'ENDCASE';
  123.         Str2 := 'ENDC';
  124.         S_Str := '{% *DO +CASE}||{% *ENDC}';
  125.         GOTO Match_Down;
  126.     END;
  127.  
  128.     IF T_Str = 'ENDD' THEN
  129.         Str1 := 'ENDD';
  130.         Xtr2 := 'DO WHILE';
  131.         Str2 := 'DO WHIL';
  132.         S_Str := '{% *DO +WHIL}||{% *ENDD}';
  133.         GOTO Match_Up;
  134.     END;
  135.  
  136.     IF T_Str = 'ENDC' THEN
  137.         Str1 := 'ENDC';
  138.         Xtr2 := 'DO CASE';
  139.         Str2 := 'DO CASE';
  140.             S_Str := '{% *DO +CASE}||{% *ENDC}';
  141.         GOTO Match_Up;
  142.     END;
  143.  
  144.     Make_Message('Looking for the Next Control Word');
  145.     GOTO_MARK;
  146.     S_Str := '{% *IF}||{% *ENDI}||{% *DO +WHIL}||{% *DO +CASE}||{% *ENDD}||{% *ENDC}||{% *TEXT}||{% *ENDT}';
  147.     S_Res := Search_Fwd(S_Str,0);
  148.     if (S_res = true) then
  149.         Make_Message('Next Control Word');
  150.     ELSE
  151.         Make_message('no control word found');
  152.     end;
  153.     GOTO Macro_Exit;
  154.  
  155. Match_Up:
  156.     Direction := 0;
  157.     goto_col(1);
  158.     GOTO Start_Match;
  159.  
  160. Match_Down:
  161.     Direction := 1;
  162.  
  163. Start_Match:
  164.     Reg_Exp_Stat := True;
  165.     Ignore_Case := True;
  166.     B_Count := 1;
  167.     S_Res := 1;
  168.     Make_Message('Matching...  Press <ESC> to Stop.');
  169.     Working;
  170.  
  171. MATCH_LOOP:   {Main loop}
  172.  
  173.                     {If the <ESC> key is pressed while matching then abort the search}
  174.     if check_key then
  175.         if key1 = 27 then
  176.             GOTO_MARK;
  177.             Make_Message('Match Aborted.');
  178.             goto macro_exit;
  179.         end;
  180.     end;
  181.  
  182.     If B_Count = 0 THEN {If match count is 0 then success}
  183.         GOTO Found_Exit;
  184.     END;
  185.  
  186.     If Direction = 1 THEN {Perform search based on direction}
  187.         Right;
  188.         S_Res := Search_Fwd(S_Str,0);
  189.     ELSE
  190.         Left;
  191.         S_Res := Search_Bwd(S_Str,0);
  192.     END;
  193.  
  194.     If S_Res = 0 THEN   {If search failed then exit}
  195.         GOTO Error_Exit;
  196.     END;
  197.  
  198.     FStr := Remove_Space(Caps(Found_Str));
  199.                                              {Get the found string and capitalize it}
  200.                                                 {If we found the first match string then}
  201.     IF FStr = STR1 THEN
  202.         B_Count := B_Count + 1;   {Inc the match count}
  203.     ELSE
  204.         IF FStr = STR2 THEN          {If we found the second match string then}
  205.             B_Count := B_Count - 1;    {  decrement the match count}
  206.         END;                         {ignore everything else}
  207.     END;
  208.  
  209.     GOTO Match_Loop;
  210.  
  211.  
  212. Error_Exit:     {Go here for unsucessfull match}
  213.     GOTO_MARK;
  214.     Make_Message('Did Not Find '+Xtr2);
  215.     GOTO Macro_Exit;
  216.  
  217. Found_Exit:     {Go here for successfull match}
  218.     POP_MARK;
  219.     Make_Message('Found '+Xtr2);
  220.  
  221. Macro_Exit:
  222.     ignore_case := temp_case;
  223.     Refresh := True;
  224.     Redraw;
  225. END_MACRO;
  226. { }
  227. $MACRO DBA_IND;
  228. {******************************************************************************
  229.                                                                 MULTI-EDIT MACRO
  230.  
  231. Name: DBA_IND
  232.  
  233. Description:  This macro will perform a smart indent when the <ENTER> key is
  234.     pressed.  This macro is called by the macro CR.
  235.  
  236.                              (C) Copyright 1989 by American Cybernetics, Inc.
  237.                                                 Contributed by Terry Lovegrove
  238. ******************************************************************************}
  239.  
  240.     DEF_STR(C_STR,S_STR,U_STR);          {Word to check for indent}
  241.     DEF_INT(T_COL,T_COL2);   {Temp column positions}
  242.     DEF_INT(sig_char_found,ind_count,jx);
  243.     DEF_CHAR(found_char);
  244.  
  245.     MARK_POS;
  246.     Reg_Exp_Stat := True;
  247.     Refresh := False;
  248.     LEFT;
  249.     {Check to see if we are inside a comment}
  250.     {Don't go back farther than 20 lines in order to improve speed}
  251.     IF Search_Bwd('@{||@}||{(@*}||{@*)}',20) THEN
  252.         IF (Cur_Char = '{') or (Cur_Char = '(') THEN
  253.             IF (Cur_Char = '{') THEN
  254.                 RIGHT;
  255.             ELSE
  256.                 RIGHT;
  257.                 RIGHT;
  258.             END;
  259.             Set_Indent_Level;
  260.             GOTO_MARK;
  261.             Refresh := True;
  262.             CR;
  263.             GOTO MAC_EXIT;
  264.         END;
  265.     END;
  266.  
  267.     GOTO_MARK;
  268.     MARK_POS;
  269.  
  270.     CALL SKIP_CLIP_NOISE1;
  271.     FOUND_CHAR := CUR_CHAR;
  272.     GOTO_MARK;
  273.     REFRESH := TRUE;
  274.  
  275.     T_COL2 := C_COL;         {Store current position}
  276.     FIRST_WORD;              {Go to the first word on the line}
  277.     T_COL := C_COL;          {Store this position}
  278.  
  279.     IF T_COL2 < T_COL THEN   {If this position is greater than the original}
  280.         T_COL := T_COL2;       {  then store the original}
  281.         GOTO_COL(T_COL);       {  and go there}
  282.     END;
  283.     IF Cur_Char <> '|0' THEN {If we are beyond the end of the line then}
  284.         SET_INDENT_LEVEL;      {  set the indent level}
  285.     END;
  286.  
  287.     T_COL := C_COL;          {Store the current position}
  288.                                                      {Get the current word, removing any extra space}
  289.     C_STR := ' ' + REMOVE_SPACE(CAPS( GET_WORD('; (,{') )) + ' ';
  290.     If XPOS(C_STR,' PROCEDURE FUNCTION DO CASE NEXT OTHERWISE IF FOR ',1) AND
  291.         XPOS(' END',C_STR,1) AND
  292.         XPOS(' ELSE',C_STR,1) THEN
  293.         GOTO MAC_EXIT;
  294.     End;
  295.     Right;
  296.     S_STR := ' ' + REMOVE_SPACE(CAPS( GET_WORD('; (,{') )) + ' ';
  297.     GOTO_COL(T_COL2);        {Put cursor on original position}
  298.     CR;                      {Perform a carriage return}
  299.  
  300.                                                      {If word in this list and not just after}
  301.                                                      { a DO CASE then pull out the word}
  302.     IF (XPOS(' END',C_STR,1) <> 0) OR
  303.         (XPOS(' ELSE',C_STR,1) <> 0) OR
  304.         (XPOS(C_STR,' NEXT OTHERWISE ',1)<> 0) THEN
  305.             CALL OUTDENT;
  306.             If C_STR = ' ENDCASE ' THEN
  307.                 CALL OUTDENT;
  308.             END;
  309.     ELSE
  310.             IF (C_STR = ' CASE ') THEN
  311.                 Mark_Pos;
  312.                 Up;
  313.                 Up;
  314.                 First_Word;
  315.                 U_STR := ' ' + REMOVE_SPACE(CAPS( GET_WORD('; (,{') )) + ' ';
  316.                 Right;
  317.                 U_STR := U_STR + REMOVE_SPACE(CAPS( GET_WORD('; (,{') )) + ' ';
  318.                 Goto_Mark;
  319.                 If (U_STR <> ' DO CASE ') Then
  320.                     CALL OUTDENT;
  321.                 END;
  322.             END;
  323.     END;
  324.                                                         {If DO CASE or DO WHILE indent}
  325.     IF (C_STR = ' DO ') AND (XPOS(S_STR,' CASE WHILE ',1)<> 0) THEN
  326.         INDENT;
  327.     END;
  328.  
  329.                                                      {If the word is in this list indent}
  330.     IF (T_COL <> T_COL2) AND (LENGTH(C_STR) <> 0) AND
  331.         ((XPOS(C_STR,' PROCEDURE FUNCTION FOR CASE OTHERWISE IF ',1)<> 0)
  332.         OR (XPOS(' ELSE',C_STR,1) <> 0)) THEN
  333.             INDENT;
  334.     END;
  335.     GOTO MAC_EXIT;
  336.  
  337. OUTDENT:
  338.                 UNDENT;
  339.                 T_Col := C_Col;
  340.                 UP;
  341.                 MARK_POS;
  342.                 FIRST_WORD;
  343.                 T_Col := C_Col - T_Col;
  344.                 GOTO_MARK;
  345.                 If T_Col > 0 Then DEL_CHARS(T_Col); End;
  346.                 DOWN;
  347.                 RET;
  348.  
  349. SKIP_CLIP_NOISE1:
  350.  
  351. { Here we look for the nearest preceding nonblank character.  If it is a
  352.     closing comment then we find the  nearest opening comment.
  353.     }
  354.  
  355.     IF (SEARCH_BWD('[~ ]', 1)) THEN
  356.         IF (CUR_CHAR = ')') THEN
  357.             LEFT;
  358.             IF (CUR_CHAR = '*') THEN
  359.                 JX := SEARCH_BWD('(@*', 0);
  360.                 LEFT;
  361.                 GOTO SKIP_CLIP_NOISE1;
  362.             END;
  363.             RIGHT;
  364.             SIG_CHAR_FOUND := TRUE;
  365.             GOTO EXIT_SKIP_CLIP;
  366.         ELSE
  367.             IF (CUR_CHAR = '}') THEN
  368.                 JX := SEARCH_BWD('@{', 0);
  369.                 LEFT;
  370.                 GOTO SKIP_CLIP_NOISE1;
  371.             END;
  372.         END;
  373.  
  374.         SIG_CHAR_FOUND := TRUE;
  375.         GOTO EXIT_SKIP_CLIP;
  376.     END;
  377.  
  378. { If we failed to find a nonblank character on the current line, and the
  379.     cursor is on line 1, we failed to find a significant character; otherwise,
  380.     we back up a line and try again. }
  381.  
  382.     IF (C_LINE = 1) THEN
  383.         SIG_CHAR_FOUND := FALSE;
  384.         GOTO EXIT_SKIP_CLIP;
  385.     END;
  386.     UP;
  387.     EOL;
  388.     GOTO SKIP_CLIP_NOISE1;
  389.  
  390. EXIT_SKIP_CLIP:
  391.     REFRESH := TRUE;
  392.     RET;
  393.  
  394.  
  395.  
  396. MAC_EXIT:
  397.  
  398. END_MACRO;
  399. { }
  400. $MACRO DBATEMP TRANS;
  401. {******************************************************************************
  402.                                                                 MULTI-EDIT MACRO
  403.  
  404. Name: DBATEMP
  405.  
  406. Description: Creates DBase language constructs based on a single character
  407.                          to the left of the current cursor position.
  408. The following constructs are created from the following templates:
  409.  
  410.             HEADF   creates a complete header for a function
  411.             HEADP   creates a complete header for a program file
  412.             f       For/Next
  413.             c       CLEAR
  414.             *       *******************************
  415.             I       If/EndIF
  416.             IE      If/Else/EndIF
  417.             D       DO/EndDO
  418.             DW      DO/While/EndDO
  419.             DC      DO/Case/CASE/OTHERWISE/EndCASE
  420.             F       FUNCTION/RETURN .T.
  421.             FP      FUNCTION/RETURN .T./PARAMETERS
  422.             U       USE
  423.             UI      USE  INDEX
  424.             P       PROCEDURE/RETURN
  425.             PA      PARAMETERS
  426.             PR      PRIVATE
  427.             PU      PUBLIC
  428.             PP      PROCEDURE/PARAMETERS/RETURN
  429.             C       CASE
  430.             @       @ ,
  431.             @       @ Row()+1,
  432.             @S      @ ,  SAY
  433.             @G      @ ,   GET
  434.             @P      @ ,   PROMPT
  435.             K       KEYBOARD
  436.             NORM    SET COLOR TO
  437.             RS      RESTORE SCREEN
  438.             RSF     RESTORE SCREEN FROM
  439.             REV     SET COLOR TO N/W
  440.             S       SELECT
  441.             SS      SAVE SCREEN
  442.             SST     SAVE SCREEN TO
  443.             SE      SET ESCAPE OFF
  444.             SC      SET CURSOR OFF
  445.             SK      SET KEY
  446.             SKT     SET KEY  TO
  447.             SW      SET WRAP  OFF
  448.             SM      SET MESSAGE TO
  449.             SO      SET ON
  450.             SF      SET OFF
  451.  
  452.                              (C) Copyright 1989 by American Cybernetics, Inc.
  453.                                                     Contributed by Terry Lovegrove
  454. ******************************************************************************}
  455.  
  456.     DEF_INT(Temp_Col,Temp_Row,
  457.                     Temp_Insert,F_Col,
  458.                     S_Pos,Par_Cnt);
  459.     DEF_STR(XStr,C_STR);
  460.     DEF_CHAR(F_CHAR);
  461.  
  462.     Temp_Insert := Insert_Mode;
  463.     Insert_Mode := True;
  464.     Temp_Col := C_COL;
  465.     FIRST_WORD;
  466.     F_Char := Caps(Cur_Char);
  467.     C_STR := Caps(GET_WORD(' '));
  468.     FIRST_WORD;
  469.     Set_Indent_Level;
  470.     F_Col := C_Col;
  471.  
  472.     If (C_Str = 'HEADF') then
  473.         GOTO MAKEHEADF;
  474.     end;
  475.  
  476.     If (C_Str = 'HEADP') then
  477.         GOTO MAKEHEADP;
  478.     end;
  479.  
  480.     {Case sensitive templates}
  481.     If (Cur_Char = 'f') Then
  482.         GOTO MAKEFOR;
  483.     END;
  484.     If (Cur_Char = 'c') Then
  485.         GOTO MAKECLEAR;
  486.     End;
  487.  
  488.     {Non-Case sensitive templates}
  489.     If (F_Char = '*') Then
  490.         Del_Char;
  491.         TEXT('*******************************');Cr;
  492.         Goto End_of_Mac;
  493.     End;
  494.  
  495.     If (F_Char = 'I') Then
  496.         GOTO MAKEIF;
  497.     End;
  498.  
  499.     If (F_Char = 'D') Then
  500.         GOTO MAKEDO;
  501.     End;
  502.  
  503.     If (F_Char = 'U') Then
  504.         GOTO MAKEUSE;
  505.     End;
  506.  
  507.     If (F_Char = 'P') Then
  508.         If (C_Str = 'PA') Then
  509.              GOTO MAKEPARAM;
  510.         ELSE
  511.         If (C_Str = 'PR') Then
  512.              GOTO MAKEPRIV;
  513.         ELSE
  514.         If (C_Str = 'PU') Then
  515.              GOTO MAKEPUBL;
  516.         ELSE
  517.              GOTO MAKEPROCEDURE;
  518.         END;END;END;
  519.     End;
  520.  
  521.     If (F_Char = 'F') Then
  522.         GOTO MAKEFUNCTION;
  523.     End;
  524.  
  525.     If (F_Char = 'C') Then
  526.         GOTO MAKECASE;
  527.     End;
  528.  
  529.     If (F_Char = '@') Then
  530.         GOTO MAKEAT;
  531.     End;
  532.  
  533.     If (F_Char = 'K') Then
  534.         GOTO MAKEKEYBRD;
  535.     End;
  536.  
  537.     If (C_STR = 'NORM') Then
  538.         GOTO MAKENORM;
  539.     End;
  540.  
  541.     If (F_Char = 'R') Then
  542.         If (C_Str = 'REV') Then
  543.             GOTO MAKEREV;
  544.         ELSE
  545.             GOTO MAKEREST;
  546.         END;
  547.     End;
  548.  
  549.     If (F_Char = 'S') Then
  550.         If Length(C_Str) > 1 Then
  551.             If XPos('S',C_Str,2) <> 0 Then
  552.                  GOTO MAKESAVE;
  553.             Else
  554.                  GOTO MAKESET;
  555.             End;
  556.         Else
  557.             GOTO MAKESELECT;
  558.         End;
  559.     End;
  560.  
  561.     {Not a proper template string}
  562.     Goto_Col(Temp_Col);
  563.     GOTO END_OF_MAC;
  564.  
  565. MAKEIF:
  566.     Del_Chars(Length(C_Str));
  567.     TEXT('If ');
  568.     EOL;
  569.     Cr;
  570.     Cr;
  571.     TEXT('EndIF');
  572.     Up;
  573.     Goto_Col(F_Col);
  574.     If C_Str = 'IE' then
  575.         Cr;
  576.         TEXT('Else ');
  577.         EOL;
  578.         Cr;
  579.         Goto_Col(F_Col);
  580.         Up;
  581.         Up;
  582.     End;
  583.     Indent;
  584.     GOTO END_OF_MAC;
  585.  
  586. MAKEDO:
  587.     Del_Chars(Length(C_Str));
  588.     TEXT('DO ');
  589.  
  590.     If C_Str = 'DW' Then
  591.         TEXT('While ');
  592.  
  593.         EOL;
  594.     Else
  595.         If C_Str = 'DC' Then
  596.             TEXT('Case');
  597.  
  598.             Cr;
  599.             Cr;
  600.             Indent;
  601.             TEXT('OTHERWISE');
  602.  
  603.             Cr;
  604.             Undent;
  605.             TEXT('EndCASE');
  606.  
  607.             Goto_Col(F_Col);
  608.             Up;
  609.             Up;
  610.             Indent;
  611.             TEXT('CASE ');
  612.  
  613.             GOTO END_OF_MAC;
  614.         End;
  615.     End;
  616.     Cr;
  617.     Cr;
  618.     TEXT('EndDO');
  619.  
  620.     Up;
  621.     Goto_Col(F_Col);
  622.     Indent;
  623.     GOTO END_OF_MAC;
  624.  
  625.  
  626. MAKEFOR:
  627.     Del_Char;
  628.     TEXT('For ');
  629.  
  630.     Cr;
  631.     Cr;
  632.     TEXT('Next');
  633.  
  634.     Goto_Col(F_Col);
  635.     Up;
  636.     Indent;
  637.     GOTO END_OF_MAC;
  638.  
  639. MAKECLEAR:
  640.     Del_Char;
  641.     TEXT('CLEAR');
  642.  
  643.     Cr;
  644.     GOTO END_OF_MAC;
  645.  
  646. MAKEUSE:
  647.     Del_Chars(Length(C_Str));
  648.     TEXT('USE ');
  649.  
  650.     EOL;
  651.     If C_Str = 'UI' then
  652.         TEXT(' INDEX ');
  653.     Else
  654.         Cr;
  655.     End;
  656.     GOTO END_OF_MAC;
  657.  
  658. MAKEPARAM:
  659.     Del_Chars(Length(C_STR));
  660.     TEXT('PARAMETERS ');
  661.     EOL;
  662.     Cr;
  663.     GOTO END_OF_MAC;
  664.  
  665. MAKEPRIV:
  666.     Del_Chars(Length(C_STR));
  667.     TEXT('PRIVATE ');
  668.     Eol;
  669.     Cr;
  670.     GOTO END_OF_MAC;
  671.  
  672. MAKEPUBL:
  673.     Del_Chars(Length(C_STR));
  674.     TEXT('PUBLIC ');
  675.     Eol;
  676.     Cr;
  677.     GOTO END_OF_MAC;
  678.  
  679. MAKEPROCEDURE:
  680.     Del_Chars(Length(C_STR));
  681.     TEXT('PROCEDURE ');
  682.  
  683.     EOL;
  684.     Cr;
  685.     Cr;
  686.     TEXT('RETURN');
  687.  
  688.     Goto_Col(F_Col);
  689.     Up;
  690.     Indent;
  691.     If C_STR = 'PP' Then
  692.         TEXT('PARAMETERS ');
  693.  
  694.     End;
  695.     GOTO END_OF_MAC;
  696.  
  697. MAKEFUNCTION:
  698.     Del_Chars(Length(C_STR));
  699.     TEXT('FUNCTION ');
  700.  
  701.     EOL;
  702.     Cr;
  703.     Cr;
  704.     TEXT('RETURN .T.');
  705.  
  706.     Goto_Col(F_Col);
  707.     Up;
  708.     Indent;
  709.     If C_STR = 'FP' Then
  710.         TEXT('PARAMETERS ');
  711.  
  712.     End;
  713.     GOTO END_OF_MAC;
  714.  
  715. MAKECASE:
  716.     Del_Char;
  717.     TEXT('CASE ');
  718.  
  719.     EOL;
  720.     Cr;
  721.     Indent;
  722.     GOTO END_OF_MAC;
  723.  
  724. MAKEAT:
  725.     Del_Chars(Length(C_Str));
  726.     Temp_Col := FALSE;
  727.     If XPos('R',C_Str,2) <> 0 then
  728.         TEXT('@ Row()+1,');
  729.     Else
  730.         TEXT('@ ,');
  731.         Temp_Col := C_Col - 1;
  732.     End;
  733.  
  734.     If XPos('C',C_Str,2) <> 0 Then
  735.         CALL GETCOL;
  736.         TEXT(XSTR);
  737.     Else
  738.         TEXT('  ');
  739.         Temp_Col := C_Col - 1;
  740.     End;
  741.     If XPos('S',C_Str,2) <> 0 Then
  742.         TEXT('SAY ');
  743.         If Temp_Col = 0 Then
  744.             Temp_Col := C_Col;
  745.         End;
  746.     End;
  747.     If XPos('G',C_Str,2) <> 0 Then
  748.         If XPos('S',C_Str,2) Then
  749.             EOL;
  750.         End;
  751.         TEXT (' GET ');
  752.     End;
  753.     If XPos('P',C_Str,2) <> 0 Then
  754.         If XPos('S',C_Str,2) Then
  755.             EOL;
  756.         End;
  757.         TEXT (' PROMPT ');
  758.     End;
  759.  
  760.     If Temp_Col Then
  761.         Goto_Col(Temp_Col);
  762.     End;
  763.     GOTO END_OF_MAC;
  764.  
  765. GETCOL:
  766.     MARK_POS;
  767.     Up;
  768.     Goto_Col(1);
  769.     If Search_Fwd('{,}{ *}{(}',1) = 0 Then
  770.         XStr := ' ';
  771.     Else
  772.         Right;
  773.         S_Pos := C_Col;
  774.         Par_Cnt := 0;
  775.         While Search_Fwd('[()]',1) <> 0 do
  776.             If Cur_Char = ')' Then
  777.                 Par_Cnt := Par_Cnt - 1;
  778.             Else
  779.             If Cur_Char = '(' Then
  780.                 Par_Cnt := Par_Cnt + 1;
  781.             End;End;
  782.             Right;
  783.         End;
  784.         If Par_Cnt = 0 Then
  785.             XStr := Copy(GET_LINE,S_Pos,C_Col-S_Pos);
  786.         Else
  787.             XStr := ' ';
  788.         End;
  789.     End;
  790.     GOTO_MARK;
  791.     RET;
  792.  
  793. MAKEKEYBRD:
  794.     Del_Chars(Length(C_Str));
  795.     TEXT('KEYBOARD ');
  796.     Eol;
  797.     Cr;
  798.     GOTO END_OF_MAC;
  799.  
  800. MAKEREV:
  801.     Del_Chars(Length(C_Str));
  802.     TEXT('SET COLOR TO N/W');
  803.     Cr;
  804.     GOTO END_OF_MAC;
  805.  
  806. MAKENORM:
  807.     Del_Chars(Length(C_Str));
  808.     TEXT('SET COLOR TO ');
  809.     Eol;
  810.     Cr;
  811.     GOTO END_OF_MAC;
  812.  
  813. MAKEREST:
  814.     Del_Chars(Length(C_Str));
  815.     TEXT('RESTORE SCREEN ');
  816.     If XPos('F',C_Str,3) <> 0 Then
  817.         TEXT('FROM ');
  818.     End;
  819.     Eol;
  820.     Cr;
  821.     GOTO END_OF_MAC;
  822.  
  823. MAKESAVE:
  824.     Del_Chars(Length(C_Str));
  825.     TEXT('SAVE SCREEN ');
  826.     If XPos('T',C_Str,3) <> 0 Then
  827.         TEXT('TO ');
  828.     End;
  829.     EOL;
  830.     Cr;
  831.     GOTO END_OF_MAC;
  832.  
  833. MAKESET:
  834.     Del_Chars(Length(C_Str));
  835.     TEXT('SET');
  836.     If XPos('E',C_Str,2) <> 0 Then
  837.         TEXT(' ESCAPE');
  838.     Else
  839.     If XPos('C',C_Str,2) <> 0 Then
  840.         TEXT(' CURSOR');
  841.     Else
  842.     If XPos('K',C_Str,2) <> 0 Then
  843.         TEXT(' KEY ');
  844.         EOL;
  845.         If XPos('T',C_Str,2) <> 0 Then
  846.             TEXT(' TO');
  847.         End;
  848.         GOTO END_OF_MAC;
  849.     Else
  850.     If XPos('W',C_Str,2) <> 0 Then
  851.         TEXT(' WRAP ');
  852.     Else
  853.     If XPos('M',C_Str,2) <> 0 Then
  854.         TEXT(' MESSAGE TO ');
  855.         GOTO END_OF_MAC;
  856.     End;End;
  857.     End;End;End;
  858.     If XPos('O',C_Str,2) <> 0 Then
  859.         TEXT(' ON');
  860.     Else
  861.         TEXT(' OFF');
  862.     End;
  863.     Cr;
  864.     GOTO END_OF_MAC;
  865.  
  866.  
  867. MAKESELECT:
  868.     Del_Chars(Length(C_Str));
  869.     TEXT('SELECT ');
  870.     EOL;
  871.     Cr;
  872.     GOTO END_OF_MAC;
  873.  
  874. MAKEHEADF:
  875.     Del_Chars(Length(C_Str));
  876.     TEXT('*******************************');Cr;
  877.     TEXT('*Function:');Cr;
  878.     TEXT('*Notes:');Cr;
  879.     TEXT('*');Cr;Cr;
  880.     TEXT('*** End of          ***********');Cr;
  881.     Up;Up;Up;Up;Up;Eol;Right;
  882.     GOTO End_of_mac;
  883.  
  884. MAKEHEADP:
  885.     Del_Chars(Length(c_Str));
  886.     TEXT('*******************************');Cr;
  887.     TEXT('*File:');Cr;
  888.     TEXT('*Author:');Cr;
  889.     TEXT('*Date:');Cr;
  890.     TEXT('*Version:');cr;
  891.     TEXT('*Notes:');cr;
  892.     TEXT('*');Cr;Cr;
  893.     TEXT('*** End of         .PRG *******');Cr;
  894.     Up;Up;Up;Up;Up;Up;Up;Up;Eol;Right;
  895.     GOTO End_of_mac;
  896.  
  897. END_OF_MAC:
  898.     Insert_Mode := Temp_Insert;
  899.  
  900. END_MACRO;
  901.