home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume1 / 8710 / vms-vi / 7 < prev    next >
Encoding:
Internet Message Format  |  1990-07-13  |  37.7 KB
  1. Path: uunet!husc6!necntc!ncoast!allbery
  2. From: gregg@a.cs.okstate.edu@mandrill.CWRU.Edu (Gregg Wonderly)
  3. Newsgroups: comp.sources.misc
  4. Subject: VI in TPU part 7/13
  5. Message-ID: <4856@ncoast.UUCP>
  6. Date: 13 Oct 87 02:52:41 GMT
  7. Sender: allbery@ncoast.UUCP
  8. Organization: Oklahoma State Univ., Stillwater
  9. Lines: 1502
  10. Approved: allbery@ncoast.UUCP
  11. X-Archive: comp.sources.misc/8710/vms-vi/7
  12.  
  13. $ WRITE SYS$OUTPUT "Creating ""VI.6"""
  14. $ CREATE VI.6
  15. $ DECK/DOLLARS=$$EOD$$
  16.             ENDIF;
  17.         ELSE
  18.             regular := 1;
  19.         ENDIF;
  20.  
  21.         IF (regular) THEN
  22.             new_pat := new_pat + cur_pat;
  23.         ELSE
  24.             IF new_pat = "" THEN
  25.                 new_pat := cur_pat;
  26.             ELSE
  27.                 new_pat := new_pat + "&" + cur_pat;
  28.             ENDIF;
  29.         ENDIF;
  30.  
  31.         pos := pos + 1;
  32.  
  33.     ENDLOOP;
  34.  
  35.     RETURN (new_pat);
  36. ENDPROCEDURE;
  37. !
  38. !
  39. ! TPU pattern generator.  Generates a pattern string from the passed
  40. ! RE string.  The function is used when :set magic is in effect.
  41. !
  42. PROCEDURE vi$re_pattern_gen (pat)
  43.  
  44.     LOCAL
  45.         first,      ! First pattern to be done
  46.         part_pat,
  47.         chno,
  48.         startchar,
  49.         haveany,
  50.         regular,
  51.         tstr,
  52.         endchar,
  53.         pat_str,
  54.         str_pat,
  55.         cur_pat,    ! The current pattern to be extracted
  56.         cur_char,   ! The current character in the regular
  57.                     ! expression being examined
  58.         new_pat,    ! The output pattern
  59.         in_ws,
  60.         pos;        ! The position within the regular
  61.                     ! expression string that we are examining
  62.                     ! currently
  63.  
  64.     vi$in_ws := 0;
  65.     IF ((INDEX (pat, "$") <> 0) OR (INDEX (pat, "[") <> 0) OR
  66.                     (INDEX (pat, "^") <> 0) OR (INDEX (pat, ".") <> 0) OR
  67.                         (INDEX (pat, "*") <> 0) OR (INDEX (pat, "\") <> 0) OR
  68.                         (INDEX (pat, '"') <> 0)) THEN
  69.         new_pat := "";
  70.     ELSE
  71.         new_pat := '"'+pat+'"';
  72.         RETURN (new_pat);
  73.     ENDIF;
  74.  
  75.     in_ws := 0;
  76.     pos := 1;
  77.  
  78.     IF SUBSTR (pat, pos, 1) = "^" THEN
  79.         new_pat := "line_begin";
  80.         pos := pos + 1;
  81.     ENDIF;
  82.  
  83.     LOOP
  84.         EXITIF (pos > LENGTH (pat));
  85.  
  86.         regular := 0;
  87.         cur_pat := "";
  88.         cur_char := substr (pat, pos, 1);
  89.         pat_str := "";
  90.  
  91.         IF (cur_char = "$") THEN
  92.             IF (pos+1 >= LENGTH (pat)) THEN
  93.                 cur_pat := "line_end";
  94.             ELSE
  95.                 vi$message ("$ found before end of string");
  96.                 RETURN (0);
  97.             ENDIF;
  98.         ELSE
  99.             IF cur_char = "[" THEN
  100.                 pos := pos + 1;
  101.  
  102.                 IF SUBSTR (pat, pos, 1) = "^" THEN
  103.                     pos := pos + 1;
  104.                     part_pat := "notany('";
  105.                 ELSE
  106.                     part_pat := "any('";
  107.                 ENDIF;
  108.  
  109.                 LOOP
  110.                     EXITIF pos > LENGTH (pat);
  111.                     EXITIF SUBSTR (pat, pos, 1) = "]";
  112.  
  113.                     IF SUBSTR (pat, pos, 1) = "\" THEN
  114.                         pos := pos + 1;
  115.                         IF pos > LENGTH (pat) THEN
  116.                             vi$message ("Missing character after \");
  117.                             RETURN ("");
  118.                         ENDIF;
  119.                     ENDIF;
  120.  
  121.                     startchar := SUBSTR (pat, pos, 1);
  122.                     pat_str := pat_str + startchar;
  123.                     IF startchar = "'" THEN
  124.                         pat_str := pat_str + "'";
  125.                     ENDIF;
  126.  
  127.                     IF (SUBSTR (pat, pos+1, 1) = '-') THEN
  128.                         pos := pos + 2;
  129.                         IF (pos >= LENGTH (pat)) THEN
  130.                             vi$message ("Missing character after '-'");
  131.                             RETURN ("");
  132.                         ENDIF;
  133.  
  134.                         endchar := SUBSTR (pat, pos, 1);
  135.  
  136.                         chno := 1;
  137.                         LOOP
  138.                             EXITIF (ASCII(chno) = startchar);
  139.                             chno := chno + 1;
  140.                         ENDLOOP;
  141.  
  142.                         LOOP
  143.                             chno := chno + 1;
  144.                             IF (chno > 255) THEN
  145.                                 vi$message (
  146.                                     "Invalid character sequence for '-'");
  147.                                 RETURN ("");
  148.                             ENDIF;
  149.  
  150.                             EXITIF (ASCII (chno-1) = endchar);
  151.                             pat_str := pat_str + ASCII (chno);
  152.                             IF ASCII (chno) = "'" THEN
  153.                                 pat_str := pat_str + "'";
  154.                             ENDIF;
  155.                         ENDLOOP;
  156.                     ENDIF;
  157.                     pos := pos + 1;
  158.                 ENDLOOP;
  159.  
  160.                 IF pat_str = "" THEN
  161.                     vi$message ("No text found between []");
  162.                     RETURN ("");
  163.                 ENDIF;
  164.  
  165.                 IF (SUBSTR (pat, pos+1, 1) = "*") THEN
  166.                     IF (part_pat = "notany('") THEN
  167.                         cur_pat := cur_pat + "(scan('"+pat_str+"')|"""")";
  168.                     ELSE
  169.                         cur_pat := cur_pat + "(span('"+pat_str+"')|"""")";
  170.                     ENDIF;
  171.                     pos := pos + 1;
  172.                 ELSE
  173.                     cur_pat := part_pat + pat_str + "')";
  174.                 ENDIF;
  175.             ELSE
  176.  
  177.                 tstr := '"';
  178.                 haveany := 0;
  179.                 regular := 1;
  180.  
  181.                 LOOP
  182.                     cur_char := SUBSTR (pat, pos, 1);
  183.                     EXITIF (cur_char = "^") OR (cur_char = "[") OR
  184.                             (cur_char = "$");
  185.                     EXITIF (pos > LENGTH (pat));
  186.  
  187.                     IF cur_char = "\" THEN
  188.                         pos := pos + 1;
  189.                         startchar := SUBSTR (pat, pos, 1);
  190.                         IF (startchar = "<") THEN
  191.                             in_ws := 1;
  192.                             vi$in_ws := 1;
  193.                             tstr := tstr + '"&(line_begin | any (vi$_ws))&"';
  194.                         ELSE
  195.                             IF (startchar = ">") THEN
  196.                                 in_ws := 0;
  197.                                 tstr := tstr + '"&(line_end | any (vi$_ws))&"';
  198.                             ELSE
  199.                                 tstr := tstr + startchar;
  200.                             ENDIF;
  201.                         ENDIF;
  202.                     ELSE
  203.                         IF (cur_char = ".") THEN
  204.                             cur_char := "longer_than_1";
  205.                         ENDIF;
  206.  
  207.                         IF (SUBSTR (pat, pos+1, 1) = '*') THEN
  208.                             pos := pos + 1;
  209.  
  210.                             IF (LENGTH (cur_char) > 1) THEN
  211.                                 cur_pat := "''&(span(vi$pch)|'')";
  212.                             ELSE
  213.                                 cur_pat := "(span('"+cur_char+"')|"""")";
  214.                             ENDIF;
  215.                             tstr := tstr+'"'+"&"+cur_pat+"&"+'"';
  216.                             haveany := 0;
  217.                         ELSE
  218.                             IF (LENGTH (cur_char) > 1) THEN
  219.                                 IF (haveany) THEN
  220.                                     tstr := tstr +'"'+"&"+"arb(1)"+"&"+'"';
  221.                                     haveany := 0;
  222.                                 ELSE
  223.                                     IF (LENGTH (tstr)>0) and (tstr <> '"') THEN
  224.                                         tstr := tstr +'"'+"&"+"arb(1)"+"&"+'"';
  225.                                     ELSE
  226.                                         tstr := "arb(1)"+"&"+'"';
  227.                                     ENDIF
  228.                                 ENDIF;
  229.                             ELSE
  230.                                 IF (cur_char = """") THEN
  231.                                     tstr := tstr + '""';
  232.                                     haveany := haveany + 2;
  233.                                 ELSE
  234.                                     tstr := tstr + cur_char;
  235.                                     haveany := haveany + 1;
  236.                                 ENDIF;
  237.                             ENDIF;
  238.                         ENDIF;
  239.                     ENDIF;
  240.                     pos := pos + 1;
  241.                 ENDLOOP;
  242.                 cur_pat := tstr + '"';
  243.                 pos := pos - 1;
  244.             ENDIF;
  245.         ENDIF;
  246.  
  247.         IF (regular) THEN
  248.             IF new_pat = "" THEN
  249.                 new_pat := cur_pat;
  250.             ELSE
  251.                 IF (LENGTH (tstr) > 1) THEN
  252.                     new_pat := new_pat + "&" + cur_pat;
  253.                 ENDIF;
  254.             ENDIF;
  255.         ELSE
  256.             IF new_pat = "" THEN
  257.                 new_pat := cur_pat;
  258.             ELSE
  259.                 new_pat := new_pat + "&" + cur_pat;
  260.             ENDIF;
  261.         ENDIF;
  262.         pos := pos + 1;
  263.  
  264.     ENDLOOP;
  265.  
  266.     IF (in_ws) THEN
  267.         MESSAGE ("Missing \> in pattern!");
  268.         RETURN (0);
  269.     ENDIF;
  270.  
  271.     RETURN (new_pat);
  272. ENDPROCEDURE;
  273.  
  274. !
  275. !   Match brackets when '%' is typed.
  276. !
  277. PROCEDURE vi$_match_brackets
  278.     vi$position (vi$match_brackets, 1);
  279. ENDPROCEDURE;
  280.  
  281. !
  282. !   Perform the actual match bracket operation.
  283. !
  284. PROCEDURE vi$match_brackets
  285.     LOCAL
  286.         newpos,
  287.         ind_pos,
  288.         found,
  289.         cur_ch,
  290.         cur_dir,
  291.         pos;
  292.  
  293.     ON_ERROR
  294.         IF ERROR = TPU$_CONTROLC THEN
  295.             vi$beep;
  296.             vi$pasthru_on;
  297.             RETURN (0);
  298.         ENDIF;
  299.     ENDON_ERROR;
  300.  
  301.     found := 1;
  302.     vi$message ("");
  303.     pos := MARK (NONE);
  304.     cur_ch := CURRENT_CHARACTER;
  305.     ind_pos := INDEX (vi$bracket_chars, cur_ch);
  306.  
  307.     IF (ind_pos = 0) THEN
  308.         newpos := SEARCH (ANCHOR & SCAN (")") & ARB (1), FORWARD, EXACT);
  309.         found := 0;
  310.         IF newpos <> 0 THEN
  311.             found := 1;
  312.             IF vi$in_show_match = 0 THEN
  313.                 vi$old_place := pos;
  314.             ENDIF;
  315.             POSITION (END_OF (newpos));
  316.             RETURN (vi$retpos (pos));
  317.         ELSE
  318.             POSITION (pos);
  319.             RETURN (0);
  320.         ENDIF;
  321.     ENDIF;
  322.  
  323.     IF ((ind_pos/2)*2 <> ind_pos) THEN
  324.         cur_dir := FORWARD;
  325.     ELSE
  326.         cur_dir := REVERSE;
  327.     ENDIF;
  328.  
  329.     SET (TIMER, ON, "Searching...");
  330.     newpos := vi$do_match (CURRENT_CHARACTER, cur_dir, 0);
  331.     SET (TIMER, OFF);
  332.  
  333.     IF (GET_INFO (newpos, "TYPE") = MARKER) THEN
  334.         RETURN (vi$retpos (pos));
  335.     ELSE
  336.         IF (newpos = 0) AND NOT (vi$in_show_match) THEN
  337.             vi$message ("No matching bracket");
  338.         ENDIF;
  339.         POSITION (pos);
  340.     ENDIF;
  341.     RETURN (0);
  342. ENDPROCEDURE;
  343. !
  344. !
  345. !  This procedure knows how to traverse nested brackets to find the matching
  346. !  bracket.  It takes the character that the cursor is positioned on, and
  347. !  finds the matching one.  It recognizes '{}', '[]', '()' pairs.
  348. !
  349. PROCEDURE vi$do_match (bracket, cur_dir, level)
  350.  
  351.     LOCAL
  352.         dgrp,
  353.         dest_char,
  354.         sel_reg,
  355.         ind_pos,
  356.         next_pos,
  357.         possibles,
  358.         cur_ch;
  359.  
  360.     ON_ERROR
  361.         RETURN (0);
  362.     ENDON_ERROR;
  363.  
  364.     IF level > 30 THEN
  365.         vi$message ("Too many nested levels");
  366.         RETURN (-1);
  367.     ENDIF;
  368.  
  369.     ! Identify the desired search direction based on the character.
  370.  
  371.     ind_pos := INDEX (vi$bracket_chars, bracket);
  372.     dest_char := SUBSTR ("}{)(][", ind_pos, 1);
  373.  
  374.     IF cur_dir = FORWARD THEN
  375.         MOVE_HORIZONTAL (1);
  376.     ENDIF;
  377.  
  378.     dgrp := bracket + dest_char;
  379.     LOOP
  380.         sel_reg := SEARCH (ANY (dgrp), cur_dir, EXACT);
  381.  
  382.         IF sel_reg = 0 THEN
  383.             RETURN (0);
  384.         ENDIF;
  385.  
  386.         POSITION (BEGINNING_OF (sel_reg));
  387.  
  388.         IF (CURRENT_CHARACTER = dest_char) THEN
  389.             RETURN (MARK (NONE));
  390.         ELSE
  391.             IF (((INDEX ("([{", CURRENT_CHARACTER) <> 0) AND
  392.                             (cur_dir = FORWARD)) OR
  393.                     ((INDEX (")}]", CURRENT_CHARACTER) <> 0) AND
  394.                             (cur_dir = REVERSE))) THEN
  395.  
  396.                 IF (INDEX (vi$bracket_chars, CURRENT_CHARACTER)-1)/2 <=
  397.                             (INDEX (vi$bracket_chars, dest_char)-1)/2 THEN
  398.  
  399.                     next_pos := vi$do_match (CURRENT_CHARACTER,
  400.                                                               cur_dir, level+1)
  401. ;
  402.  
  403.                     IF (next_pos <> 0) AND (next_pos <> -1) THEN
  404.                         POSITION (next_pos);
  405.                     ELSE
  406.                         RETURN (next_pos);
  407.                     ENDIF;
  408.                 ENDIF;
  409.             ELSE
  410.                 IF (INDEX (vi$bracket_chars, CURRENT_CHARACTER) = 0) THEN
  411.                     vi$message ("Unknown bracket character: '"+
  412.                                                     CURRENT_CHARACTER+"'");
  413.                     RETURN (-1);
  414.                 ENDIF;
  415.             ENDIF;
  416.  
  417.             IF cur_dir = FORWARD THEN
  418.                 MOVE_HORIZONTAL (1);
  419.             ENDIF;
  420.         ENDIF;
  421.     ENDLOOP;
  422. ENDPROCEDURE;
  423.  
  424. !
  425. !   Move to the top line of the window when 'H' is pressed.
  426. !
  427. PROCEDURE home
  428.     POSITION (vi$to_home);
  429. ENDPROCEDURE;
  430.  
  431. !
  432. !   Perform the actual movement for the 'H' command and return the marker.
  433. !
  434. PROCEDURE vi$to_home
  435.  
  436.     LOCAL
  437.         pos;
  438.  
  439.     ON_ERROR
  440.         ! Ignore attempt to move beyond end of buffer errors.
  441.     ENDON_ERROR;
  442.  
  443.     pos := MARK (NONE);
  444.     MOVE_VERTICAL ( GET_INFO (CURRENT_WINDOW, "VISIBLE_TOP") -
  445.                     GET_INFO (CURRENT_WINDOW, "CURRENT_ROW"));
  446.  
  447.     vi$yank_mode := VI$LINE_MODE;
  448.     RETURN (vi$retpos(pos));
  449. ENDPROCEDURE
  450.  
  451. !
  452. !   Position the cursor into the middle of the current window when 'M' is
  453. !   pressed.
  454. !
  455. PROCEDURE vi$middle
  456.     POSITION (vi$to_middle);
  457. ENDPROCEDURE;
  458.  
  459. !
  460. !   Perform the actual movement of the 'M' command.
  461. !
  462. PROCEDURE vi$to_middle
  463.  
  464.     LOCAL
  465.         len,
  466.         cur,
  467.         top,
  468.         pos;
  469.  
  470.     ON_ERROR
  471.         ! Ignore attempt to move beyond end of buffer errors.
  472.     ENDON_ERROR;
  473.  
  474.     pos := MARK (NONE);
  475.  
  476.     len := GET_INFO (CURRENT_WINDOW, "VISIBLE_LENGTH");
  477.     cur := GET_INFO (CURRENT_WINDOW, "CURRENT_ROW");
  478.     top := GET_INFO (CURRENT_WINDOW, "VISIBLE_TOP");
  479.  
  480.     MOVE_VERTICAL (((len-top+1)/2) - (cur - top + 1));
  481.  
  482.     vi$yank_mode := VI$LINE_MODE;
  483.     RETURN (vi$retpos(pos));
  484. ENDPROCEDURE;
  485.  
  486. !
  487. !   Move the the last line of the current window when 'L' is pressed.
  488. !
  489. PROCEDURE vi$last
  490.     POSITION (vi$to_last);
  491. ENDPROCEDURE;
  492.  
  493. !
  494. !   Perform the actual movement associated with the 'L' command.
  495. !
  496. PROCEDURE vi$to_last
  497.  
  498.     LOCAL
  499.         pos;
  500.  
  501.     ON_ERROR
  502.         ! Ignore attempt to move beyond end of buffer errors.
  503.     ENDON_ERROR;
  504.  
  505.     pos := MARK (NONE);
  506.     MOVE_VERTICAL ( GET_INFO (CURRENT_WINDOW, "VISIBLE_BOTTOM") -
  507.                     GET_INFO (CURRENT_WINDOW, "CURRENT_ROW"));
  508.  
  509.     vi$yank_mode := VI$LINE_MODE;
  510.     RETURN (vi$retpos (pos));
  511. ENDPROCEDURE
  512.  
  513. !
  514. !   Move to the end of the current line when '$' is pressed.
  515. !
  516. PROCEDURE vi$_eol
  517.     POSITION (vi$eol);
  518. ENDPROCEDURE;
  519.  
  520. !
  521. !   Perform the actual movement associated with the '$' command.
  522. !
  523. PROCEDURE vi$eol
  524.     LOCAL
  525.         pos;
  526.  
  527.     ON_ERROR
  528.         RETURN (pos);
  529.     ENDON_ERROR;
  530.  
  531.     pos := MARK (NONE);
  532.     MOVE_HORIZONTAL (-CURRENT_OFFSET);
  533.     MOVE_HORIZONTAL (LENGTH (vi$current_line));
  534.     vi$check_rmarg;
  535.  
  536.     vi$yank_mode := VI$IN_LINE_MODE;
  537.     RETURN (vi$retpos (pos));
  538. ENDPROCEDURE;
  539.  
  540. !
  541. !   Move the first non-blank character of the line when '^' is typed.
  542. !
  543. PROCEDURE vi$_bol
  544.     vi$position (vi$first_no_space, 0);
  545. ENDPROCEDURE;
  546.  
  547. !
  548. !   Move the beginning of the line when '0' is typed.
  549. !
  550. PROCEDURE vi$fol
  551.     LOCAL
  552.         pos;
  553.  
  554.     pos := MARK (NONE);
  555.     MOVE_HORIZONTAL (-CURRENT_OFFSET);
  556.     vi$yank_mode := VI$IN_LINE_MODE;
  557.     vi$new_offset := 1;
  558.     RETURN (vi$retpos (pos));
  559. ENDPROCEDURE;
  560.  
  561. !
  562. !   Move the the location searched for.
  563. !
  564. PROCEDURE vi$_search (direction)
  565.     LOCAL
  566.         pos;
  567.  
  568.     pos := vi$search(direction);
  569.  
  570.     vi$position (pos, 1);
  571.     IF (pos <> 0) THEN
  572.         vi$pos_in_middle (MARK (NONE));
  573.     ENDIF;
  574. ENDPROCEDURE;
  575.  
  576. !
  577. !   Move to the next location of the string previously searched for.
  578. !
  579. PROCEDURE vi$_search_next (direction)
  580.     LOCAL
  581.         pos;
  582.  
  583.     pos := vi$search_next(direction);
  584.  
  585.     vi$position (pos, 1);
  586.     IF (pos <> 0) THEN
  587.         vi$pos_in_middle (MARK (NONE));
  588.     ENDIF;
  589. ENDPROCEDURE;
  590.  
  591. !
  592. !   Repeat the last 't' or 'f' command backwards.
  593. !
  594. PROCEDURE vi$_repeat_torf_back
  595.     vi$position (vi$repeat_torf_back, 0);
  596. ENDPROCEDURE
  597.  
  598. !
  599. !   Repeat the last 't' or 'f' command.
  600. !
  601. PROCEDURE vi$_repeat_torf
  602.     vi$position (vi$repeat_torf, 0);
  603. ENDPROCEDURE
  604.  
  605. !
  606. !   Return the location found by repeating the last 't', 'f', 'T' or 'F'
  607. !   command backwards.
  608. !
  609. PROCEDURE vi$repeat_torf_back
  610.     LOCAL
  611.         old_func,
  612.         back_func;
  613.  
  614.     IF vi$last_s_func = 0 THEN
  615.         RETURN (0);
  616.     ENDIF;
  617.  
  618.     old_func := vi$last_s_func;
  619.     IF (vi$last_s_func = "vi$back_find_char") THEN
  620.         back_func := "vi$find_char";
  621.     ENDIF;
  622.     IF (vi$last_s_func = "vi$find_char") THEN
  623.         back_func := "vi$back_find_char";
  624.     ENDIF;
  625.     IF (vi$last_s_func = "vi$back_to_char") THEN
  626.         back_func := "vi$to_char";
  627.     ENDIF;
  628.     IF (vi$last_s_func = "vi$to_char") THEN
  629.         back_func := "vi$back_to_char";
  630.     ENDIF;
  631.  
  632.     vi$global_var := 0;
  633.     EXECUTE (COMPILE (
  634.         "vi$global_var := " + back_func + "('"+vi$last_s_char + "')"));
  635.     vi$last_s_func := old_func;
  636.     RETURN (vi$global_var);
  637. ENDPROCEDURE
  638.  
  639. !
  640. !   Return the location found by repeating the last 't', 'f', 'T' or 'F'
  641. !   command.
  642. !
  643. PROCEDURE vi$repeat_torf
  644.     IF vi$last_s_func = 0 THEN
  645.         RETURN (0);
  646.     ENDIF;
  647.  
  648.     vi$global_var := 0;
  649.     EXECUTE (COMPILE (
  650.         "vi$global_var := " + vi$last_s_func + "('"+vi$last_s_char + "')"));
  651.     RETURN (vi$global_var);
  652. ENDPROCEDURE
  653.  
  654. !
  655. !   Return the value of a positive integer that is represented as a string.
  656. !   If the string is not a valid integer, then -1 is retured.
  657. !
  658. PROCEDURE vi$number_from_string (str_num)
  659.     ON_ERROR
  660.         RETURN (-1);
  661.     ENDON_ERROR;
  662.  
  663.     RETURN (INT (str_num));
  664. ENDPROCEDURE;
  665.  
  666. !
  667. !   Move to the line indicated by 'line_no', and return the marker that
  668. !   indicates the beginning of that line.
  669. !
  670. PROCEDURE vi$mark_line (line_no)
  671.  
  672.     LOCAL
  673.         pos;
  674.  
  675.     ON_ERROR
  676.         POSITION (pos);
  677.         RETURN (0);
  678.     ENDON_ERROR;
  679.  
  680.     pos := MARK (NONE);
  681.     POSITION (BEGINNING_OF (CURRENT_BUFFER));
  682.     MOVE_VERTICAL (line_no - 1);
  683.     RETURN (vi$retpos (pos));
  684. ENDPROCEDURE;
  685.  
  686. !
  687. !   Perform an EX mode command after a ':' is typed.
  688. !
  689. PROCEDURE vi$ex_mode
  690.     LOCAL
  691.         cmd_str;
  692.  
  693.     IF (vi$read_a_line (":", cmd_str) <> 0) and (cmd_str <> "") THEN
  694.         IF (vi$do_cmd_line (cmd_str) = 0) THEN
  695.             vi$message ("");
  696.         ENDIF;
  697.     ENDIF;
  698. ENDPROCEDURE;
  699.  
  700. !
  701. !
  702. !
  703. PROCEDURE vi$read_a_line (prompt, cmd_str)
  704.     LOCAL
  705.         cmd_idx,
  706.         addch,
  707.         ch,
  708.         did_ctl_v,
  709.         win,
  710.         pos;
  711.  
  712.     win := CURRENT_WINDOW;
  713.     pos := MARK (NONE);
  714.  
  715.     POSITION (END_OF (command_buffer));
  716.     MAP (command_window, command_buffer);
  717.     COPY_TEXT (prompt);
  718.     SET (OVERSTRIKE, CURRENT_BUFFER);
  719.  
  720.     cmd_str := "";
  721.     cmd_idx := 0;
  722.     LOOP
  723.         vi$update (CURRENT_WINDOW);
  724.         ch := vi$read_a_key;
  725.  
  726.         did_ctl_v := 0;
  727.         IF ch = CTRL_V_KEY THEN
  728.             COPY_TEXT ("^");
  729.             did_ctl_v := 1;
  730.             MOVE_HORIZONTAL (-1);
  731.             vi$update (CURRENT_WINDOW);
  732.             ch := vi$read_a_key;
  733.             ERASE_CHARACTER (1);
  734.         ENDIF;
  735.  
  736.         EXITIF ((ch = RET_KEY) OR (ch = F11)) AND (did_ctl_v = 0);
  737.  
  738.         IF (ch = RET_KEY) THEN ch := CTRL_M_KEY; ENDIF;
  739.         IF (ch = F12) THEN ch := CTRL_H_KEY; ENDIF;
  740.         IF (ch = F11) THEN ch := KEY_NAME (ASCII (27)); ENDIF;
  741.  
  742.         IF ((ch = DEL_KEY) OR (ch = CTRL_H_KEY)) AND (did_ctl_v = 0) THEN
  743.             IF cmd_idx = 0 THEN
  744.                 UNMAP (command_window);
  745.                 UNMAP (message_window);
  746.                 MAP (message_window, message_buffer);
  747.                 POSITION (win);
  748.                 POSITION (pos);
  749.                 RETURN (0);
  750.             ENDIF;
  751.             ch := SUBSTR (cmd_str, cmd_idx, 1);
  752.             cmd_idx := cmd_idx - 1;
  753.             IF (INDEX (vi$_ctl_chars, ch) <> 0) THEN
  754.                 MOVE_HORIZONTAL (-2);
  755.             ELSE
  756.                 MOVE_HORIZONTAL (-1);
  757.             ENDIF;
  758.             cmd_str := SUBSTR (cmd_str, 1, cmd_idx);
  759.         ELSE
  760.             IF (ch <= KEY_NAME (ASCII (31))) AND (ch >= CTRL_A_KEY) THEN
  761.                 IF ch = TAB_KEY THEN
  762.                     addch := 9;
  763.                     COPY_TEXT (ASCII(addch));
  764.                 ELSE
  765.                     addch := ((ch - CTRL_A_KEY) / 256) + 1;
  766.                     COPY_TEXT ("^");
  767.                     COPY_TEXT (ASCII (addch + 64));
  768.                 ENDIF;
  769.                 cmd_str := cmd_str + ASCII (addch);
  770.                 cmd_idx := cmd_idx + 1;
  771.                 IF ch = 27 THEN ch := F11; ENDIF;
  772.             ELSE
  773.                 IF (ch = UP) THEN
  774.                     vi$next_in_cmd (cmd_str, cmd_idx, prompt, -1);
  775.                 ELSE
  776.                     IF (ch = DOWN) THEN
  777.                         vi$next_in_cmd (cmd_str, cmd_idx, prompt, 1);
  778.                     ELSE
  779.                         COPY_TEXT (ASCII(ch));
  780.                         cmd_str := cmd_str + ASCII (ch);
  781.                         cmd_idx := cmd_idx + 1;
  782.                     ENDIF;
  783.                 ENDIF;
  784.             ENDIF;
  785.         ENDIF;
  786.     ENDLOOP;
  787.  
  788.     ERASE_CHARACTER (LENGTH (CURRENT_LINE) - CURRENT_OFFSET);
  789.  
  790.     POSITION (END_OF (command_buffer));
  791.     LOOP
  792.         MOVE_VERTICAL (-1);
  793.         EXITIF (CURRENT_LINE <> prompt);
  794.         ERASE_LINE;
  795.     ENDLOOP;
  796.  
  797.     IF (CURRENT_LINE <> prompt + cmd_str) THEN
  798.         MOVE_VERTICAL (1);
  799.         COPY_TEXT (prompt + cmd_str);
  800.     ENDIF;
  801.  
  802.     UNMAP (command_window);
  803.     UNMAP (message_window);
  804.     MAP (message_window, message_buffer);
  805.  
  806.     POSITION (win);
  807.     POSITION (pos);
  808.  
  809.     RETURN (1);
  810. ENDPROCEDURE;
  811.  
  812. !
  813. !   This procedure looks from the next occurence of 'prompt' at the
  814. !   beginning of the line, in the direction dir (1 or -1).  If prompt
  815. !   is found, then cmd_str is set to the contents of that line, minus
  816. !   the text of the prompt, and cmd_idx is set to the length of cmd_str.
  817. !   The cursor is left positioned at the end of the line found, or if
  818. !   none is found, it is not moved.
  819. !
  820. PROCEDURE vi$next_in_cmd (cmd_str, cmd_idx, prompt, dir)
  821.     LOCAL
  822.         pos,
  823.         len;
  824.  
  825.     ON_ERROR
  826.         POSITION (pos);
  827.         RETURN;
  828.     ENDON_ERROR;
  829.  
  830.     pos := MARK (NONE);
  831.     len := LENGTH (prompt);
  832.  
  833.     MOVE_HORIZONTAL (-CURRENT_OFFSET);
  834.     LOOP
  835.         EXITIF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) AND (dir = -1);
  836.         EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER)) AND (dir = 1);
  837.         MOVE_VERTICAL (DIR);
  838.         IF SUBSTR (CURRENT_LINE, 1, len) = prompt THEN
  839.             cmd_str := SUBSTR (CURRENT_LINE, len+1,
  840.                                             LENGTH (CURRENT_LINE) - len + 1);
  841.             cmd_idx := LENGTH (cmd_str);
  842.             MOVE_HORIZONTAL (LENGTH (CURRENT_LINE));
  843.             RETURN;
  844.         ENDIF;
  845.     ENDLOOP;
  846.     POSITION (pos);
  847. ENDPROCEDURE;
  848.  
  849. !
  850. !   Perform a whole series of command separated by '|'s.
  851. !
  852. PROCEDURE vi$do_cmd_line (cmd)
  853.     LOCAL
  854.         ch,
  855.         retval,
  856.         idx,
  857.         strg;
  858.  
  859.     idx := 1;
  860.     strg := "";
  861.  
  862.     LOOP
  863.         EXITIF (idx > LENGTH (cmd));
  864.         ch := SUBSTR (cmd, idx, 1);
  865.         IF (ch = "|") THEN
  866.             retval := vi$do_command (strg);
  867.             IF (retval > 1) THEN
  868.                 RETURN (retval);
  869.             ELSE
  870.                 IF (retval = 0) THEN
  871.                     MESSAGE ("");
  872.                 ENDIF;
  873.             ENDIF;
  874.             strg := 0;
  875.         ELSE
  876.             IF (ch = "\") THEN
  877.                 idx := idx + 1;
  878.                 IF (SUBSTR (cmd, idx, 1) = "|") THEN
  879.                     strg := strg + "|";
  880.                 ELSE
  881.                     strg := strg + "\" + SUBSTR (cmd, idx, 1);
  882.                 ENDIF;
  883.             ELSE
  884.                 strg := strg + ch;
  885.             ENDIF;
  886.         ENDIF;
  887.         idx := idx + 1;
  888.     ENDLOOP;
  889.  
  890.     IF (strg <> 0) THEN
  891.         IF (vi$do_command (strg) <> 0) THEN
  892.             RETURN (1);
  893.         ELSE
  894.             MESSAGE ("");
  895.         ENDIF;
  896.     ENDIF;
  897.     RETURN (0);
  898. ENDPROCEDURE;
  899.  
  900. !
  901. !   Perform an EX (not all are implemented) command as given in "cmd".
  902. !
  903. PROCEDURE vi$do_command (cmd)
  904.     LOCAL
  905.         rng,
  906.         outf,
  907.         mode,
  908.         token_1,
  909.         token_2,
  910.         token_3,
  911.         res_spec,
  912.         start_mark,
  913.         end_mark,
  914.         start_line,
  915.         end_line,
  916.         work_range,
  917.         whole_range,
  918.         buf,
  919.         pos,
  920.         spos,
  921.         rest,
  922.         separ,
  923.         no_spec,
  924.         ch,
  925.         i,
  926.         j,
  927.         olen,
  928.         bang,
  929.         num,
  930.         pos;
  931.  
  932.     olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
  933.  
  934.     ! Start at beginning of string and look for a range of lines.
  935.  
  936.     i := 1;
  937.  
  938.     pos := MARK (NONE);
  939.     num := vi$get_line_spec (i, cmd);
  940.  
  941.     no_spec := 0;
  942.     IF (num < 0) THEN
  943.         IF (vi$parse_next_ch (i, cmd, "%")) THEN
  944.             start_line := 1;
  945.             end_line := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
  946.         ELSE
  947.             no_spec := 1;
  948.             start_line := vi$cur_line_no;
  949.             end_line := start_line;
  950.         ENDIF;
  951.     ELSE
  952.         start_line := num;
  953.         IF (vi$parse_next_ch (i, cmd, ",")) THEN
  954.             num := vi$get_line_spec (i, cmd);
  955.             IF (num < 0) THEN
  956.                 vi$message ("Invalid line range specification!");
  957.                 RETURN (1);
  958.             ENDIF;
  959.             end_line := num;
  960.         ELSE
  961.             end_line := start_line;
  962.         ENDIF;
  963.     ENDIF;
  964.  
  965.     POSITION (pos);
  966.  
  967.     work_range := 0;
  968.     whole_range := 0;
  969.  
  970.     IF (start_line > end_line) THEN
  971.         vi$message ("Bad range of lines!");
  972.         RETURN (1);
  973.     ENDIF;
  974.  
  975.     start_mark := vi$mark_line (start_line);
  976.     end_mark := vi$mark_line (end_line);
  977.  
  978.     IF (start_mark = 0) OR (end_mark = 0) THEN
  979.         vi$message ("Bad range of lines!");
  980.         RETURN (1);
  981.     ENDIF;
  982.  
  983.     work_range := CREATE_RANGE (start_mark, end_mark, NONE);
  984.  
  985.     pos := MARK (NONE);
  986.     POSITION (end_mark);
  987.  
  988.     IF (end_mark <> END_OF (CURRENT_BUFFER)) THEN
  989.         MOVE_VERTICAL (1);
  990.     ENDIF;
  991.  
  992.     IF (end_mark <> BEGINNING_OF (CURRENT_BUFFER)) THEN
  993.         MOVE_HORIZONTAL (-1);
  994.     ENDIF;
  995.  
  996.     whole_range := CREATE_RANGE (start_mark, MARK (NONE), NONE);
  997.     POSITION (pos);
  998.  
  999.     !   If there is no command then move to the line indicated.
  1000.  
  1001.     rest := vi$rest_of_line (cmd, i);
  1002.     EDIT (rest, COLLAPSE);
  1003.     IF rest = "" THEN
  1004.         vi$old_place := MARK (NONE);
  1005.         POSITION (start_mark);
  1006.         RETURN (0);
  1007.     ENDIF;
  1008.  
  1009.     token_1 := vi$get_cmd_token (vi$_lower_chars, cmd, i);
  1010.  
  1011.     IF (token_1 = "help") THEN
  1012.         RETURN (vi$do_help (vi$rest_of_line (cmd, i)));
  1013.     ENDIF;
  1014.  
  1015.     IF (token_1 = "show") THEN
  1016.         RETURN (vi$do_show (cmd, i));
  1017.     ENDIF;
  1018.  
  1019.     ! Check for substitution alias.
  1020.  
  1021.     IF (token_1 = "") AND (vi$parse_next_ch (i, cmd, "&")) THEN
  1022.         RETURN (vi$do_subs_alias (cmd, i, start_line, end_line, whole_range));
  1023.     ENDIF;
  1024.  
  1025.     IF (token_1 = "") AND (vi$parse_next_ch (i, cmd, "@")) THEN
  1026.         RETURN (vi$do_macro_buffer (cmd, i));
  1027.     ENDIF;
  1028.  
  1029.     IF (token_1 = "learn") THEN
  1030.         RETURN (vi$do_learn (cmd, i));
  1031.     ENDIF;
  1032.  
  1033.     IF (token_1 = "unlearn") THEN
  1034.         RETURN (vi$do_unlearn (cmd, i));
  1035.     ENDIF;
  1036.  
  1037.     IF (token_1 = "g") THEN
  1038.         RETURN (vi$do_global (cmd, i));
  1039.     ENDIF;
  1040.  
  1041.     IF (token_1 = "sh") OR (token_1 = "dcl") THEN
  1042.         RETURN (vi$spawn (0));
  1043.     ENDIF;
  1044.  
  1045.     IF (vi$leading_str (token_1, "unabbr") AND (LENGTH (token_1) > 4)) THEN
  1046.         RETURN (vi$do_unabbr (cmd, i));
  1047.     ENDIF;
  1048.  
  1049.     IF (vi$leading_str (token_1, "abbr") AND (LENGTH (token_1) > 3)) THEN
  1050.         RETURN (vi$do_abbr (cmd, i));
  1051.     ENDIF;
  1052.  
  1053.     IF (vi$leading_str (token_1, "edit")) OR
  1054.                                         (vi$leading_str (token_1, "vi")) THEN
  1055.         RETURN (vi$do_edit (cmd, i, token_1));
  1056.     ENDIF;
  1057.  
  1058.     IF (token_1 = "") THEN
  1059.         IF (vi$parse_next_ch (i, cmd, "!")) THEN
  1060.             RETURN (vi$do_subproc (cmd, i));
  1061.         ENDIF;
  1062.     ENDIF;
  1063.  
  1064.     IF (vi$leading_str (token_1, "copy")) THEN
  1065.         RETURN (vi$do_copy (cmd, i, whole_range, olen, start_line, end_line));
  1066.     ENDIF;
  1067.  
  1068.     IF (vi$leading_str (token_1, "move")) THEN
  1069.         RETURN (vi$do_move (cmd, i, whole_range, start_line, end_line));
  1070.     ENDIF;
  1071.  
  1072.     IF (vi$leading_str (token_1, "select")) AND (LENGTH (token_1) > 2) THEN
  1073.         RETURN (vi$do_select);
  1074.     ENDIF;
  1075.  
  1076.     IF (token_1 = "fill") THEN
  1077.         RETURN (vi$do_fill (cmd, i, whole_range, olen));
  1078.     ENDIF;
  1079.  
  1080.     IF ((LENGTH (token_1) > 1) AND (vi$leading_str (token_1, "upper") OR
  1081.                                     vi$leading_str (token_1, "lower") OR
  1082.                                     vi$leading_str (token_1, "invert"))) THEN
  1083.         RETURN (vi$do_case (token_1, whole_range));
  1084.     ENDIF;
  1085.  
  1086.     IF (token_1 = "s") THEN
  1087.         RETURN (vi$do_substitute (start_line, end_line, whole_range, i, cmd));
  1088.     ENDIF;
  1089.  
  1090.     IF (token_1 = "d") THEN
  1091.         RETURN (vi$do_delete (start_mark, whole_range, olen));
  1092.     ENDIF;
  1093.  
  1094.     ! Do the write file command.  You can write either a buffer, or a
  1095.     ! portion of one.
  1096.  
  1097.     IF (vi$leading_str (token_1, "write")) THEN
  1098.         RETURN (vi$do_write (cmd, i, no_spec, token_1, whole_range));
  1099.     ENDIF;
  1100.  
  1101.     IF (token_1 = "wq") THEN
  1102.         RETURN (vi$do_wq (cmd, i, no_spec, token_1, whole_range));
  1103.     ENDIF;
  1104.  
  1105.     ! Read in a file to the current buffer.
  1106.  
  1107.     IF (vi$leading_str (token_1, "read")) THEN
  1108.         RETURN (vi$do_read (cmd, i, start_line, olen));
  1109.     ENDIF;
  1110.  
  1111.     IF (vi$leading_str (token_1, "file")) THEN
  1112.         RETURN (vi$do_file_ex (cmd, i));
  1113.     ENDIF;
  1114.  
  1115.     IF (vi$leading_str (token_1, "buffer")) THEN
  1116.         RETURN (vi$do_buffer (cmd, i, token_1));
  1117.     ENDIF;
  1118.  
  1119.     IF (token_1 = "so") THEN
  1120.         RETURN (vi$do_file (vi$rest_of_line (cmd, i), 1));
  1121.     ENDIF;
  1122.  
  1123.     IF (vi$leading_str (token_1, "messages")) THEN
  1124.         RETURN (vi$do_messages);
  1125.     ENDIF;
  1126.  
  1127.     IF (vi$leading_str (token_1, "delbuf")) THEN
  1128.         RETURN (vi$do_delbuf (cmd, i));
  1129.     ENDIF;
  1130.  
  1131.     IF (vi$leading_str (token_1, "xit")) THEN
  1132.         RETURN (vi$_ZZ);
  1133.     ENDIF;
  1134.  
  1135.     IF (token_1 = "rew") THEN
  1136.         RETURN (vi$_first_file);
  1137.     ENDIF;
  1138.  
  1139.     IF (vi$leading_str (token_1, "prev")) THEN
  1140.         RETURN (vi$_previous_file);
  1141.     ENDIF;
  1142.  
  1143.     IF (vi$leading_str (token_1, "next")) THEN
  1144.         RETURN (vi$_next_file);
  1145.     ENDIF;
  1146.  
  1147.     IF (token_1 = "tag") OR (token_1 = "ta") THEN
  1148.         vi$skip_white (cmd, i);
  1149.         IF (vi$rest_of_line (cmd, i) = "") THEN
  1150.             RETURN (vi$do_tag (0));
  1151.         ELSE
  1152.             RETURN (vi$do_tag (vi$rest_of_line (cmd, i)));
  1153.         ENDIF;
  1154.     ENDIF;
  1155.  
  1156.     IF (token_1 = "map") THEN
  1157.         RETURN (vi$map_keys (cmd, i));
  1158.     ENDIF;
  1159.  
  1160.     IF (token_1 = "unmap") THEN
  1161.         RETURN (vi$unmap_keys (cmd, i));
  1162.     ENDIF;
  1163.  
  1164.     IF (token_1 = "set") THEN
  1165.         RETURN (vi$set_commands (cmd, i));
  1166.     ENDIF;
  1167.  
  1168.     IF (token_1 = "tpu") THEN
  1169.         RETURN (vi$do_tpu (cmd, i, no_spec, whole_range));
  1170.     ENDIF;
  1171.  
  1172.     IF (token_1 = "cd") OR (token_1 = "chdir") THEN
  1173.         RETURN (vi$do_cd (cmd, i));
  1174.     ENDIF;
  1175.  
  1176.     ! Quit the current editor session.
  1177.  
  1178.     IF (vi$leading_str (token_1, "quit")) THEN
  1179.         RETURN (vi$do_quit (cmd, token_1));
  1180.     ENDIF;
  1181.  
  1182.     MESSAGE ("Unrecognized command!");
  1183.     RETURN (1);
  1184. ENDPROCEDURE;
  1185.  
  1186. !
  1187. !
  1188. !
  1189. PROCEDURE vi$do_unlearn (cmd, i)
  1190.     LOCAL
  1191.         keyn,
  1192.         com;
  1193.  
  1194.     MESSAGE ("Press the key you want to unlearn: ");
  1195.     keyn := vi$read_a_key;
  1196.  
  1197.     IF (keyn = F11) OR (ASCII (27) = ASCII (keyn)) THEN
  1198.         MESSAGE ("UNLEARN aborted!");
  1199.         RETURN (1);
  1200.     ENDIF;
  1201.  
  1202.     com := LOOKUP_KEY (keyn, COMMENT, vi$cmd_keys);
  1203.     IF (com <> "learn_sequence") THEN
  1204.         MESSAGE ("That key is not a learned KEY!");
  1205.         RETURN (1);
  1206.     ENDIF;
  1207.  
  1208.     UNDEFINE_KEY (keyn, vi$cmd_keys);
  1209. ENDPROCEDURE;
  1210.  
  1211. !
  1212. !
  1213. !
  1214. PROCEDURE vi$do_learn (cmd, i)
  1215.     LOCAL
  1216.         keyn,
  1217.         strg;
  1218.  
  1219.     MESSAGE ("Type KEY sequence, and press CTRL-R to remember sequence");
  1220.     vi$in_learn := 1;
  1221.     LEARN_BEGIN (EXACT);
  1222.     RETURN (1);
  1223. ENDPROCEDURE;
  1224.  
  1225. !
  1226. !   Remember the keystrokes that have been typed.
  1227. !
  1228. PROCEDURE vi$remember
  1229.  
  1230.     LOCAL
  1231.         key,
  1232.         keyn,
  1233.         com;
  1234.  
  1235.     ON_ERROR
  1236.         RETURN (1);
  1237.     ENDON_ERROR;
  1238.  
  1239.     IF (vi$in_learn = 0) THEN
  1240.         RETURN (0);
  1241.     ENDIF;
  1242.  
  1243.     MESSAGE ("Press key to bind sequence to: ");
  1244.     keyn := vi$read_a_key;
  1245.  
  1246.     IF (keyn = F11) OR (ASCII (27) = ASCII (keyn)) THEN
  1247.         MESSAGE ("LEARN aborted!");
  1248.         com := LEARN_END;
  1249.         vi$in_learn := 0;
  1250.         RETURN (1);
  1251.     ENDIF;
  1252.  
  1253.     com := LOOKUP_KEY (keyn, COMMENT, vi$cmd_keys);
  1254.     IF (com = "active_macro") THEN
  1255.         MESSAGE ("That key is a mapped key, you must unmap it first");
  1256.         RETURN (1);
  1257.     ENDIF;
  1258.  
  1259.     key := "vi$ls_"+vi$key_map_name (keyn);
  1260.     EXECUTE (COMPILE (key+":=LEARN_END"));
  1261.     vi$in_learn := 0;
  1262.     DEFINE_KEY ("vi$play_back("+key+")", keyn, "learn_sequence", vi$cmd_keys);
  1263.     MESSAGE ("Sequence bound to key");
  1264.     RETURN (1);
  1265. ENDPROCEDURE;
  1266.  
  1267. !
  1268. !
  1269. !
  1270. PROCEDURE vi$play_back (prog)
  1271.     LOCAL
  1272.         old_play_back,
  1273.         old_global;
  1274.  
  1275.     IF (vi$m_level > 30) THEN
  1276.         MESSAGE ("Infinite loop detected in key macro sequence!");
  1277.         RETURN;
  1278.     ENDIF;
  1279.     vi$m_level := vi$m_level + 1;
  1280.  
  1281.     IF vi$undo_map THEN
  1282.         old_global := vi$in_global;
  1283.         vi$in_global := 0;
  1284.         IF (NOT old_global) THEN
  1285.             vi$save_for_undo (CURRENT_BUFFER, VI$LINE_MODE, 1);
  1286.             vi$in_global := 1;
  1287.         ENDIF;
  1288.     ENDIF;
  1289.  
  1290.     old_play_back := vi$playing_back;
  1291.     vi$playing_back := 1;
  1292.     EXECUTE (prog);
  1293.     vi$playing_back := old_play_back;
  1294.     vi$m_level := vi$m_level - 1;
  1295.  
  1296.     vi$in_global := old_global;
  1297. ENDPROCEDURE;
  1298.  
  1299. !
  1300. !   Remove an abbreviation
  1301. !
  1302. PROCEDURE vi$do_unabbr (cmd, i)
  1303.     LOCAL
  1304.         separ,
  1305.         junk,
  1306.         idx,
  1307.         ch,
  1308.         abbr,
  1309.         abbrn;
  1310.  
  1311.     abbr := "";
  1312.     abbrn := "";
  1313.  
  1314.     junk := vi$skip_separ (cmd, i, "    ", separ);
  1315.     IF (LENGTH (junk) = 0) THEN
  1316.         MESSAGE ("Abbreviation name required!");
  1317.         RETURN (1);
  1318.     ENDIF;
  1319.  
  1320.     idx := 1;
  1321.     LOOP
  1322.         EXITIF idx > LENGTH (junk);
  1323.         ch := SUBSTR (junk, idx, 1);
  1324.         IF (INDEX (vi$_alpha_chars, ch) = 0) THEN
  1325.             MESSAGE ("Invalid character in UNABBR name, '"+ch+
  1326.                                                         "', is not valid.");
  1327.             RETURN (1);
  1328.         ENDIF;
  1329.         IF (INDEX (vi$_upper_chars, ch) <> 0) THEN
  1330.             abbrn := abbrn + "_";
  1331.         ENDIF;
  1332.         abbrn := abbrn + ch;
  1333.         idx := idx + 1;
  1334.     ENDLOOP;
  1335.     EXECUTE (COMPILE ("VI$ABBR_"+abbrn+":=0;"));
  1336.     RETURN (0);
  1337. ENDPROCEDURE;
  1338.  
  1339. !
  1340. !   Create an abbreviation
  1341. !
  1342. PROCEDURE vi$do_abbr (cmd, i)
  1343.     LOCAL
  1344.         separ,
  1345.         abbr,
  1346.         junk,
  1347.         idx,
  1348.         ch,
  1349.         abbrn;
  1350.  
  1351.     abbr := "";
  1352.     abbrn := "";
  1353.  
  1354.     junk := vi$skip_separ (cmd, i, "    ", separ);
  1355.     IF (LENGTH (junk) = 0) THEN
  1356.         vi$show_abbrevs;
  1357.         RETURN (0);
  1358.     ENDIF;
  1359.  
  1360.     idx := 1;
  1361.     LOOP
  1362.         EXITIF idx > LENGTH (junk);
  1363.         ch := SUBSTR (junk, idx, 1);
  1364.         IF (INDEX (vi$_alpha_chars, ch) = 0) THEN
  1365.             MESSAGE ("Invalid character in ABBR name, '"+ch+"', is not valid.")
  1366. ;
  1367.             RETURN (1);
  1368.         ENDIF;
  1369.         IF (INDEX (vi$_upper_chars+"_", ch) <> 0) THEN
  1370.             abbrn := abbrn + "_";
  1371.         ENDIF;
  1372.         abbrn := abbrn + ch;
  1373.         idx := idx + 1;
  1374.     ENDLOOP;
  1375.     abbr := vi$rest_of_line (cmd, i);
  1376.     EXECUTE (COMPILE ("VI$ABBR_"+abbrn+":="""+abbr+""""));
  1377.     RETURN (0);
  1378. ENDPROCEDURE;
  1379.  
  1380. !
  1381. !   Execute the contents of the buffers named following an '@'.
  1382. !
  1383. PROCEDURE vi$do_macro_buffer (cmd, i)
  1384.     LOCAL
  1385.         line,
  1386.         mode,
  1387.         buf_name,
  1388.         pos,
  1389.         buf,
  1390.         ch;
  1391.  
  1392.     ON_ERROR
  1393.     ENDON_ERROR;
  1394.  
  1395.     vi$skip_white (cmd, i);
  1396.  
  1397.     LOOP
  1398.         ch := vi$next_char (cmd, i);
  1399.         EXITIF (ch = "");
  1400.  
  1401.         IF (INDEX ("123456789", ch) <> 0) THEN
  1402.  
  1403.             ! Selected a deletion buffer.
  1404.  
  1405.             buf_name := "vi$del_buf_" + ch;
  1406.         ELSE
  1407.             IF (INDEX (vi$_letter_chars, ch) <> 0) THEN
  1408.  
  1409.                 ! Selected a named buffer.
  1410.  
  1411.                 CHANGE_CASE (ch, LOWER);
  1412.  
  1413.                 buf_name := "vi$ins_buf_" + ch;
  1414.             ELSE
  1415.                 vi$message ("Invalid buffer!");
  1416.                 RETURN;
  1417.             ENDIF;
  1418.         ENDIF;
  1419.  
  1420.         vi$global_var := 0;
  1421.         EXECUTE (COMPILE ("vi$global_var := "+buf_name+";"));
  1422.         buf := vi$global_var;
  1423.         IF (buf = 0) THEN
  1424.             vi$message ("There is no text in that buffer!");
  1425.             RETURN;
  1426.         ENDIF;
  1427.  
  1428.         pos := MARK (NONE);
  1429.         POSITION (BEGINNING_OF (buf));
  1430.  
  1431.         !  Skip the buffer mode indicator.
  1432.  
  1433.         mode := INT (vi$current_line);
  1434.         MOVE_VERTICAL (1);
  1435.         line := vi$current_line;
  1436.  
  1437.         IF mode = VI$LINE_MODE THEN
  1438.             line := line + ASCII (13);
  1439.         ENDIF;
  1440.  
  1441.         POSITION (pos);
  1442.         vi$do_macro (line, 1);
  1443.     ENDLOOP;
  1444.  
  1445. ENDPROCEDURE;
  1446.  
  1447. !
  1448. !
  1449. !
  1450. PROCEDURE vi$do_global (cmd, i)
  1451.     LOCAL
  1452.         cmd_str,
  1453.         sch_str,
  1454.         subs_str,
  1455.         sch,
  1456.         ch,
  1457.         nsubs,
  1458.         lpos,
  1459.         olen,
  1460.         fpos;
  1461.  
  1462.     olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
  1463.     vi$skip_white (cmd, i);
  1464.     IF NOT vi$parse_next_ch (i, cmd, "/") THEN
  1465.         MESSAGE ("/ Search string must follow global!");
  1466.         RETURN (1);
  1467.     ENDIF;
  1468.  
  1469.     sch := SUBSTR (cmd, i-1, 1);
  1470.     sch_str := "";
  1471.     LOOP
  1472.         EXITIF (vi$parse_next_ch (i, cmd, sch));
  1473.         EXITIF (LENGTH (cmd) < i);
  1474.         ch := SUBSTR (cmd, i, 1);
  1475.         IF (ch = "\") THEN
  1476.             sch_str := sch_str + SUBSTR (cmd, i, 2);
  1477.             i := i + 1;
  1478.         ELSE
  1479.             sch_str := sch_str + ch;
  1480.         ENDIF;
  1481.         i := i + 1;
  1482.     ENDLOOP;
  1483.  
  1484.     IF (LENGTH (cmd) < i) THEN
  1485.         MESSAGE ("Incomplete command!");
  1486.         RETURN (1);
  1487.     ENDIF;
  1488.  
  1489.     vi$save_for_undo (CURRENT_BUFFER, VI$LINE_MODE, 1);
  1490.     cmd_str := vi$rest_of_line (cmd, i);
  1491.  
  1492.     SET (FORWARD, CURRENT_BUFFER);
  1493.     POSITION (BEGINNING_OF (CURRENT_BUFFER));
  1494.  
  1495.     nsubs := 0;
  1496.     subs_str := SUBSTR (cmd_str, 2, 255);
  1497.  
  1498.     LOOP
  1499.         fpos := vi$find_str (sch_str, 1);
  1500.         EXITIF fpos = 0;
  1501.  
  1502.         POSITION (fpos);
  1503.         IF cmd_str = "d" THEN
  1504.             ERASE_LINE;
  1505.         ELSE
  1506.             IF SUBSTR (cmd_str, 1, 1) = "s" THEN
  1507.                 lpos := vi$global_subs (subs_str, nsubs);
  1508.                 MOVE_HORIZONTAL (-CURRENT_OFFSET);
  1509.                 MOVE_VERTICAL (1);
  1510.             ELSE
  1511.                 MESSAGE ("Bad command for global: "+cmd_str);
  1512.                 vi$kill_undo;
  1513.                 vi$undo_end := 0;
  1514. $$EOD$$
  1515.