home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume1 / 8710 / vms-vi / 6 < prev    next >
Encoding:
Internet Message Format  |  1990-07-13  |  38.3 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 6/13
  5. Message-ID: <4855@ncoast.UUCP>
  6. Date: 13 Oct 87 02:51:59 GMT
  7. Sender: allbery@ncoast.UUCP
  8. Organization: Oklahoma State Univ., Stillwater
  9. Lines: 1503
  10. Approved: allbery@ncoast.UUCP
  11. X-Archive: comp.sources.misc/8710/vms-vi/6
  12.  
  13. $ WRITE SYS$OUTPUT "Creating ""VI.5"""
  14. $ CREATE VI.5
  15. $ DECK/DOLLARS=$$EOD$$
  16.         ENDIF;
  17.         RETURN;
  18.     ENDIF;
  19.  
  20.     IF (key = TAB_KEY) THEN
  21.          key := ASCII (9);
  22.     ELSE
  23.         IF (key = RET_KEY) THEN
  24.              key := ASCII (13);
  25.         ELSE
  26.             IF (key = DEL_KEY) THEN
  27.                  key := ASCII (8);
  28.             ELSE
  29.                 key := ASCII (key);
  30.             ENDIF;
  31.         ENDIF;
  32.     ENDIF;
  33.  
  34.     IF ((CURRENT_OFFSET + act_cnt) <= LENGTH (vi$current_line)) THEN
  35.         IF (key = ASCII (13)) THEN
  36.             MOVE_HORIZONTAL (act_cnt);
  37.         ELSE
  38.             MOVE_HORIZONTAL (act_cnt - 1);
  39.         ENDIF;
  40.         vi$save_for_undo (CREATE_RANGE (pos, MARK(NONE), NONE),
  41.                                                         VI$IN_LINE_MODE, 1);
  42.         IF (key = ASCII (13)) THEN
  43.             MOVE_HORIZONTAL (-act_cnt);
  44.         ELSE
  45.             MOVE_HORIZONTAL (-(act_cnt-1));
  46.         ENDIF;
  47.         IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
  48.             MOVE_HORIZONTAL (-1);
  49.             vi$undo_start := MARK (NONE);
  50.             MOVE_HORIZONTAL (1);
  51.         ELSE
  52.             vi$undo_start := 0;
  53.         ENDIF;
  54.  
  55.         SET (OVERSTRIKE, CURRENT_BUFFER);
  56.         LOOP
  57.             IF (key = ASCII (13)) THEN
  58.                 SPLIT_LINE;
  59.                 ERASE_CHARACTER (1);
  60.             ELSE
  61.                 COPY_TEXT (key);
  62.             ENDIF;
  63.             act_cnt := act_cnt - 1;
  64.             EXITIF act_cnt = 0;
  65.         ENDLOOP;
  66.  
  67.         IF (key = ASCII (13)) THEN
  68.             MOVE_HORIZONTAL (1);
  69.         ENDIF;
  70.  
  71.         MOVE_HORIZONTAL (-1);
  72.         vi$undo_end := MARK (NONE);
  73.  
  74.         SET (INSERT, CURRENT_BUFFER);
  75.         IF (vi$undo_start = 0) THEN
  76.             vi$undo_start := BEGINNING_OF (CURRENT_BUFFER);
  77.         ELSE
  78.             pos := MARK (NONE);
  79.             POSITION (vi$undo_start);
  80.             MOVE_HORIZONTAL (1);
  81.             vi$undo_start := MARK (NONE);
  82.             POSITION (pos);
  83.         ENDIF;
  84.     ELSE
  85.         POSITION (pos);
  86.     ENDIF;
  87.  
  88.     IF (vi$show_mode) THEN
  89.         MESSAGE ("");
  90.     ENDIF;
  91.     RETURN;
  92. ENDPROCEDURE
  93.  
  94. !
  95. !   Perform the 'R' command
  96. !
  97. PROCEDURE vi$_replace_str
  98.  
  99.     LOCAL
  100.         replace,
  101.         max_mark,
  102.         start_pos,
  103.         spos,
  104.         pos,
  105.         max_col;
  106.  
  107.     pos := MARK (NONE);
  108.     max_col := CURRENT_OFFSET;
  109.     start_pos := max_col;
  110.     MOVE_HORIZONTAL (LENGTH (CURRENT_LINE) - CURRENT_OFFSET);
  111.     max_mark := MARK(NONE);
  112.     vi$undo_end := MARK (NONE);
  113.     POSITION (pos);
  114.     vi$update (CURRENT_WINDOW);
  115.     replace := CURRENT_LINE;
  116.     spos := vi$get_undo_start;
  117.     vi$save_for_undo (CREATE_RANGE (pos, max_mark, NONE), VI$IN_LINE_MODE, 1);
  118.  
  119.     vi$line_edit (max_col, start_pos, max_mark, replace);
  120.     pos := MARK (NONE);
  121.     vi$undo_start := vi$set_undo_start (spos);
  122.     POSITION (pos);
  123. ENDPROCEDURE;
  124.  
  125. !
  126. !   As in REAL vi, this procedure does not recognize a repeat count.
  127. !   A simple loop would make it possible to use the repeat count contained
  128. !   in "vi$active_count".  A macro is used so that all of the crap for undo
  129. !   need not be placed here.
  130. !
  131. PROCEDURE vi$_change_case
  132.     LOCAL
  133.         pos;
  134.  
  135.     vi$active_count := 0;
  136.     pos := INDEX (vi$_lower_chars, CURRENT_CHARACTER);
  137.     IF pos <> 0 THEN
  138.         vi$do_macro ("r"+SUBSTR (vi$_upper_chars, pos, 1)+"l", 0);
  139.     ELSE
  140.         pos := INDEX (vi$_upper_chars, CURRENT_CHARACTER);
  141.         IF pos <> 0 THEN
  142.             vi$do_macro ("r"+SUBSTR (vi$_lower_chars, pos, 1)+"l", 0);
  143.         ELSE
  144.             vi$kill_undo;
  145.             vi$undo_end := 0;
  146.             MOVE_HORIZONTAL (1);
  147.         ENDIF;
  148.     ENDIF;
  149.  
  150. ENDPROCEDURE;
  151.  
  152. !
  153. !
  154. !
  155. PROCEDURE vi$init_action (olen)
  156.     LOCAL
  157.         nchar;
  158.  
  159.     olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
  160.  
  161.     IF (vi$select_pos = 0) THEN
  162.         nchar := vi$read_a_key;
  163.         IF (INDEX ("123456789", ASCII(nchar)) <> 0) THEN
  164.             vi$active_count := INDEX (vi$_numeric_chars, ASCII(nchar)) - 1;
  165.             LOOP
  166.                 nchar := vi$read_a_key;
  167.                 EXITIF (INDEX (vi$_numeric_chars, ASCII(nchar)) = 0);
  168.                 vi$active_count := vi$active_count *
  169.                         10 + (INDEX (vi$_numeric_chars, ASCII (nchar)) - 1);
  170.             ENDLOOP;
  171.         ENDIF;
  172.     ELSE
  173.         nchar := KEY_NAME (".");
  174.     ENDIF;
  175.     RETURN (nchar);
  176. ENDPROCEDURE;
  177.  
  178. !
  179. !
  180. !
  181. PROCEDURE vi$get_prog (nchar)
  182.     IF (vi$select_pos = 0) THEN
  183.         RETURN (LOOKUP_KEY (KEY_NAME (nchar), COMMENT, vi$move_keys));
  184.     ELSE
  185.         RETURN ("vi$get_select_pos");
  186.     ENDIF;
  187. ENDPROCEDURE;
  188.  
  189. !
  190. !
  191. !
  192. PROCEDURE vi$do_movement (prog, mtype)
  193.  
  194.     vi$endpos := 0;
  195.     vi$new_endpos := 0;
  196.     vi$command_type := mtype;
  197.  
  198.     EXECUTE (COMPILE ("vi$endpos := " + prog));
  199.     IF vi$new_endpos <> 0 THEN
  200.         vi$endpos := vi$new_endpos;
  201.     ENDIF;
  202. ENDPROCEDURE;
  203.  
  204. !
  205. !   Perform the operations associated with the 'c' command.
  206. !
  207. PROCEDURE vi$_change
  208.  
  209.     LOCAL
  210.         max_mark,
  211.         max_col,
  212.         start_col,
  213.         start_offset,
  214.         end_offset,
  215.         start_line,
  216.         end_line,
  217.         cha_range,
  218.         pos,
  219.         olen,
  220.         prog,
  221.         do_back,
  222.         nchar;
  223.  
  224.     ON_ERROR;
  225.         vi$message ("Error occured during change, at line: "+STR(ERROR_LINE));
  226.         POSITION (vi$start_pos);
  227.         RETURN;
  228.     ENDON_ERROR;
  229.  
  230.     vi$new_offset := 1;
  231.     nchar := vi$init_action (olen);
  232.  
  233.     IF (nchar = KEY_NAME ('c')) THEN
  234.         vi$_big_s;
  235.         RETURN;
  236.     ENDIF;
  237.  
  238.     ! If the movement will be backwards, then the region must not include
  239.     ! the current character.
  240.  
  241.     do_back := vi$get_direction (nchar);
  242.  
  243.     IF do_back THEN
  244.         vi$move_horizontal (-1);
  245.         vi$start_pos := MARK (NONE);
  246.         vi$move_horizontal (1);
  247.     ELSE
  248.         vi$start_pos := MARK (NONE);
  249.     ENDIF;
  250.  
  251.     prog := vi$get_prog (nchar);
  252.  
  253.     IF prog <> "" THEN
  254.         vi$do_movement (prog, VI$CHANGE_TYPE);
  255.  
  256.         POSITION (vi$start_pos);
  257.         start_offset := CURRENT_OFFSET;
  258.         MOVE_HORIZONTAL (-CURRENT_OFFSET);
  259.         start_line := MARK (NONE);
  260.         POSITION (vi$start_pos);
  261.  
  262.         IF (vi$endpos <> 0) THEN
  263.             POSITION (vi$endpos);
  264.             MOVE_HORIZONTAL (-CURRENT_OFFSET);
  265.             end_line := MARK (NONE);
  266.             POSITION (vi$endpos);
  267.  
  268.             IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) AND
  269.                         (NOT do_back) AND
  270.                         (INDEX (vi$weird_moves, ASCII (nchar)) = 0) THEN
  271.                 vi$move_horizontal (-1);
  272.             ENDIF;
  273.             end_offset := CURRENT_OFFSET + 1;
  274.  
  275.             cha_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);
  276.  
  277.             IF (start_line <> end_line) THEN
  278.                 IF (cha_range <> 0) THEN
  279.                     POSITION (vi$start_pos);
  280.  
  281.                     vi$undo_start := vi$get_undo_start;
  282.  
  283.                     vi$save_for_undo (cha_range, vi$yank_mode, 0);
  284.                     ERASE (cha_range);
  285.  
  286.                     IF (vi$while_not_esc = 0) THEN
  287.                         vi$undo_end := 0;
  288.                     ELSE
  289.                         vi$undo_end := MARK (NONE);
  290.                         vi$undo_start := vi$set_undo_start (vi$undo_start);
  291.                         POSITION (vi$undo_end);
  292.                     ENDIF;
  293.                 ELSE
  294.                     vi$message ("Internal error while changing!");
  295.                 ENDIF;
  296.             ELSE
  297.                 IF (cha_range <> 0) THEN
  298.                     IF (start_offset < end_offset) THEN
  299.                         max_col := end_offset;
  300.                         MOVE_HORIZONTAL (1);
  301.                         max_mark := MARK (NONE);
  302.                         MOVE_HORIZONTAL (-1);
  303.                         start_col := start_offset;
  304.                     ELSE
  305.                         POSITION (vi$start_pos);
  306.                         MOVE_HORIZONTAL (1);
  307.                         max_col := CURRENT_OFFSET;
  308.                         max_mark := MARK (NONE);
  309.                         POSITION (vi$start_pos);
  310.                         start_col := end_offset - 1;
  311.                     ENDIF;
  312.  
  313.                     vi$save_for_undo (SUBSTR (vi$current_line, start_col + 1,
  314.                             max_col - start_col), vi$yank_mode, 0);
  315.  
  316.                     SET (OVERSTRIKE, CURRENT_BUFFER);
  317.                     COPY_TEXT ("$");
  318.                     SET (INSERT, CURRENT_BUFFER);
  319.  
  320.                     IF (start_offset < end_offset) THEN
  321.                         POSITION (vi$start_pos);
  322.                     ELSE
  323.                         POSITION (vi$endpos);
  324.                     ENDIF;
  325.  
  326.                     vi$update (CURRENT_WINDOW);
  327.  
  328.                     vi$undo_start := vi$get_undo_start;
  329.  
  330.                     if (vi$line_edit (max_col, start_col, max_mark, 0) = 0) THE
  331. N
  332.                         vi$undo_end := 0;
  333.                         IF (start_col <> 0) THEN
  334.                             MOVE_HORIZONTAL (1);
  335.                         ENDIF;
  336.                     ELSE
  337.                         IF (CURRENT_OFFSET = 0) THEN
  338.                             MOVE_HORIZONTAL (-1);
  339.                             vi$undo_end := MARK (NONE);
  340.                             MOVE_HORIZONTAL (1);
  341.                         ELSE
  342.                             vi$undo_end := MARK (NONE);
  343.                         ENDIF;
  344.                     ENDIF;
  345.  
  346.                     pos := MARK (NONE);
  347.  
  348.                     vi$undo_start := vi$set_undo_start (vi$undo_start);
  349.                     POSITION (pos);
  350.                 ELSE
  351.                     vi$message ("Internal error while changing!");
  352.                 ENDIF;
  353.             ENDIF;
  354.         ELSE
  355.             vi$abort (0);
  356.         ENDIF;
  357.     ELSE
  358.         vi$abort (0);
  359.     ENDIF;
  360.  
  361.     vi$check_length (olen);
  362. ENDPROCEDURE;
  363.  
  364. !
  365. !   Decide which direction the movement will be based on whether or not
  366. !   the last movement was a t, T, f, F, or other backward movement.
  367. !
  368. PROCEDURE vi$get_direction (nchar)
  369.     LOCAL
  370.         do_back;
  371.  
  372.     do_back := 0;
  373.  
  374.     IF ((ASCII (nchar) = ",") AND ((vi$last_s_func = "vi$find_char") OR
  375.                                         (vi$last_s_func = "vi$to_char"))) OR
  376.         ((ASCII (nchar) = ";") AND ((vi$last_s_func = "vi$back_find_char") OR
  377.                                     (vi$last_s_func = "vi$back_to_char"))) THEN
  378.         do_back := 1;
  379.     ENDIF;
  380.  
  381.     IF (INDEX (vi$back_moves + vi$weird2_moves, ASCII(nchar)) <> 0) THEN
  382.         do_back := 1;
  383.     ENDIF;
  384.  
  385.     RETURN (do_back);
  386. ENDPROCEDURE;
  387.  
  388. !
  389. !   Given the fact that a select range is active, modify vi$start_pos
  390. !   to be the start of that range, and return the end of the select
  391. !   range.
  392. !
  393. PROCEDURE vi$get_select_pos
  394.     LOCAL
  395.         pos,
  396.         rng;
  397.  
  398.     rng := SELECT_RANGE;
  399.     IF (rng <> 0) THEN
  400.         pos := MARK (NONE);
  401.         vi$select_pos := 0;
  402.         vi$start_pos := BEGINNING_OF (rng);
  403.         POSITION (END_OF (rng));
  404.         MOVE_HORIZONTAL (1);
  405.         RETURN (vi$retpos (pos));
  406.     ELSE
  407.         vi$select_pos := 0;
  408.         vi$message ("No region selected!");
  409.     ENDIF;
  410.     RETURN (0);
  411. ENDPROCEDURE;
  412.  
  413. !
  414. !   Perform the operations associated with the 'S' command.
  415. !
  416. PROCEDURE vi$_big_s
  417.     LOCAL
  418.         max_mark,
  419.         start_pos,
  420.         max_col,
  421.         rng,
  422.         start,
  423.         end,
  424.         pos;
  425.  
  426.     MOVE_HORIZONTAL (-CURRENT_OFFSET);
  427.     MOVE_HORIZONTAL (-1);
  428.     vi$undo_start := MARK (NONE);
  429.     MOVE_HORIZONTAL (1);
  430.  
  431.     IF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) THEN
  432.         vi$undo_end := 0;
  433.     ENDIF;
  434.  
  435.     start := MARK (NONE);
  436.     IF (LENGTH (vi$current_line) > 0) THEN
  437.         MOVE_VERTICAL (vi$cur_active_count - 1);
  438.         MOVE_HORIZONTAL (LENGTH (vi$current_line) - 1);
  439.     ENDIF;
  440.  
  441.     end := MARK (NONE);
  442.     rng := CREATE_RANGE (start, end, NONE);
  443.     POSITION (start);
  444.     vi$save_for_undo (rng, VI$IN_LINE_MODE, 1);
  445.  
  446.     ERASE (rng);
  447.  
  448.     max_col := CURRENT_OFFSET;
  449.     start_pos := max_col;
  450.     max_mark := MARK(NONE);
  451.  
  452.     vi$update (CURRENT_WINDOW);
  453.  
  454.     IF (vi$line_edit (max_col, start_pos, max_mark, 0) <> 0) THEN
  455.         vi$undo_end := MARK (NONE);
  456.     ELSE
  457.         vi$undo_end := 0;
  458.     ENDIF;
  459.     pos := MARK (NONE);
  460.     vi$undo_start := vi$set_undo_start (vi$undo_start);
  461.     POSITION (pos);
  462. ENDPROCEDURE;
  463.  
  464. !
  465. !   This function performs the operations associated with the '"' command
  466. !   that allows one of the 26 named buffers, or one of the 10 delete
  467. !   buffers to be the target of a 'd', 'D', 'x', 'X', 'y', 'Y', 'p' or 'P'
  468. !   command.
  469. !
  470. PROCEDURE vi$select_buffer
  471.     LOCAL
  472.         numeric,
  473.         asc_action,
  474.         action,
  475.         prog,
  476.         buf_name,
  477.         nchar;
  478.  
  479.     ON_ERROR;
  480.         RETURN;
  481.     ENDON_ERROR;
  482.  
  483.     nchar := vi$read_a_key;
  484.     action := vi$read_a_key;
  485.     asc_action := ASCII (action);
  486.     numeric := (INDEX (vi$_numeric_chars, asc_action) <> 0);
  487.  
  488.     IF numeric THEN
  489.         vi$active_count := INDEX (vi$_numeric_chars, asc_action) - 1;
  490.         LOOP
  491.             action := vi$read_a_key;
  492.             asc_action := ASCII (action);
  493.             EXITIF (INDEX (vi$_numeric_chars, asc_action) = 0);
  494.             vi$active_count := (vi$active_count * 10) +
  495.                                     (INDEX (vi$_numeric_chars, asc_action) - 1)
  496. ;
  497.         ENDLOOP;
  498.     ENDIF;
  499.  
  500.     IF  (asc_action <> 'P') AND (asc_action <> 'p') AND (asc_action <> 'd') AND
  501.         (asc_action <> 'D') AND (asc_action <> 'y') AND (asc_action <> 'Y') AND
  502.         (asc_action <> 'x') AND (asc_action <> 'X') AND (NOT numeric) THEN
  503.  
  504.         vi$message ("Unrecognized buffer action, ignoring: '"+asc_action+"'");
  505.  
  506.         RETURN;
  507.     ENDIF;
  508.  
  509.     IF (INDEX ("123456789", ASCII(nchar)) <> 0) THEN
  510.  
  511.         IF  (asc_action <> 'P') AND (asc_action <> 'p') THEN
  512.             RETURN;
  513.         ENDIF;
  514.  
  515.         ! Selected a deletion buffer.
  516.  
  517.         buf_name := "vi$del_buf_"+ASCII(nchar);
  518.  
  519.     ELSE
  520.         IF (INDEX (vi$_letter_chars, ASCII(nchar)) <> 0) THEN
  521.  
  522.             ! Selected a named buffer.
  523.  
  524.             IF (INDEX (vi$_upper_chars, ASCII(nchar)) <> 0) THEN
  525.                 nchar := SUBSTR (vi$_lower_chars,
  526.                             INDEX (vi$_upper_chars, ASCII(nchar)), 1);
  527.             ENDIF;
  528.  
  529.             buf_name := "vi$ins_buf_"+ASCII(nchar);
  530.  
  531.             ! Only create a buffer if we are going to put something into it.
  532.  
  533.             IF  (asc_action <> 'P') AND (asc_action <> 'p') THEN
  534.                 EXECUTE (COMPILE ('vi$get_ins_buf(' +
  535.                                             buf_name + ', "'+buf_name+'");'));
  536.             ELSE
  537.                 vi$global_var := 0;
  538.                 EXECUTE (COMPILE ("vi$global_var:="+buf_name));
  539.                 IF (vi$global_var = 0) THEN
  540.                     MESSAGE ("There is nothing in that buffer!");
  541.                     RETURN;
  542.                 ENDIF;
  543.             ENDIF;
  544.         ELSE
  545.             vi$message ("Invalid buffer!");
  546.             RETURN;
  547.         ENDIF;
  548.     ENDIF;
  549.  
  550.     ! We now have a buffer, and the next command key, so envoke the
  551.     ! proper code.
  552.  
  553.     vi$do_buf_act (asc_action, 'P', "vi$put_here (VI$HERE, "+buf_name+");");
  554.     vi$do_buf_act  (asc_action, 'p', "vi$put_after ("+buf_name+");");
  555.     vi$do_buf_act  (asc_action, 'd', "vi$_delete (0, "+buf_name+");");
  556.     vi$do_buf_act  (asc_action, 'D',
  557.                                 "vi$_delete (KEY_NAME('$'), "+buf_name+");");
  558.     vi$do_buf_act  (asc_action, 'x', "vi$_delete ('l', "+buf_name+");");
  559.     vi$do_buf_act  (asc_action, 'X', "vi$_delete ('h', "+buf_name+");");
  560.     vi$do_buf_act  (asc_action, 'y', "vi$_yank (0, "+buf_name+");");
  561.     vi$do_buf_act  (asc_action, 'Y', "vi$_yank ('y', "+buf_name+");");
  562.     vi$do_buf_act  (asc_action, 'Y', "vi$_yank (KEY_NAME('y'), "+buf_name+");")
  563. ;
  564. ENDPROCEDURE;
  565.  
  566. !
  567. !   Perform action based on key typed and passed data
  568. !
  569. PROCEDURE vi$do_buf_act (act_type, look_for, what_to_do)
  570.  
  571.     IF (act_type = look_for) THEN
  572.         EXECUTE (COMPILE (what_to_do));
  573.     ENDIF;
  574. ENDPROCEDURE;
  575.  
  576. !
  577. !   Create a buffer named 'bname' providing that there is not already a
  578. !   buffer by that name.
  579. !
  580. PROCEDURE vi$get_ins_buf (buf, bname)
  581.  
  582.     IF (buf = 0) THEN
  583.         buf := vi$init_buffer (bname, "");
  584.     ENDIF;
  585.  
  586.     IF buf = 0 THEN
  587.         vi$message ("Error creating named buffer!");
  588.     ENDIF;
  589. ENDPROCEDURE;
  590.  
  591. !
  592. !   Perform the delete command tied to the 'd' key.
  593. !
  594. PROCEDURE vi$_delete (opchar, dest_buf)
  595.  
  596.     LOCAL
  597.         olen,
  598.         old_offset,
  599.         new_offset,
  600.         era_range,
  601.         opos,
  602.         prog,
  603.         do_back,
  604.         nchar;
  605.  
  606.     ON_ERROR;
  607.         vi$message ("Error occured during delete, at line: "+STR(ERROR_LINE));
  608.         POSITION (vi$start_pos);
  609.         RETURN;
  610.     ENDON_ERROR;
  611.  
  612.     vi$new_offset := 1;
  613.     nchar := opchar;
  614.  
  615.     opos := MARK (NONE);
  616.     IF (nchar = 0) THEN
  617.         nchar := vi$init_action (olen);
  618.     ELSE
  619.         olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
  620.     ENDIF;
  621.  
  622.     ! If the movement will be backwards, then the region must not include
  623.     ! the current character.
  624.  
  625.     old_offset := -1;
  626.     new_offset := -1;
  627.  
  628.     do_back := vi$get_direction (nchar);
  629.  
  630.     IF do_back THEN
  631.         old_offset := CURRENT_OFFSET;
  632.         vi$move_horizontal (-1);
  633.         new_offset := CURRENT_OFFSET;
  634.     ENDIF;
  635.  
  636.     vi$start_pos := MARK (NONE);
  637.  
  638.     ! For "dh" or "X" (a macro of "dh"), we must let vi$left do the movement.
  639.  
  640.     IF (INDEX (vi$weird2_moves, ASCII(nchar)) <> 0) AND
  641.                                                 (old_offset <> new_offset) THEN
  642.         MOVE_HORIZONTAL (1);
  643.     ENDIF;
  644.  
  645.     prog := vi$get_prog (nchar);
  646.  
  647.     IF prog <> "" THEN
  648.         vi$do_movement (prog, VI$DELETE_TYPE);
  649.  
  650.         IF (vi$endpos <> 0) THEN
  651.             POSITION (vi$endpos);
  652.  
  653.             IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) AND
  654.                         (NOT do_back) AND
  655.                         (INDEX (vi$weird_moves, ASCII (nchar)) = 0) THEN
  656.                 MOVE_HORIZONTAL (-1);
  657.             ENDIF;
  658.  
  659.             era_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);
  660.  
  661.             IF (era_range <> 0) THEN
  662.                 IF (GET_INFO (dest_buf, "TYPE") = INTEGER) THEN
  663.                     vi$cur_text := vi$put2del_buf (vi$yank_mode, era_range);
  664.                 ELSE
  665.                     vi$type2buf (STR (vi$yank_mode), dest_buf);
  666.                     vi$cur_text := vi$cp2buf (era_range, dest_buf);
  667.                 ENDIF;
  668.  
  669.                 vi$undo_end := 0;
  670.                 vi$undo_start := vi$start_pos;
  671.                 POSITION (BEGINNING_OF (era_range));
  672.                 vi$save_for_undo (era_range, vi$yank_mode, 1);
  673.                 ERASE (era_range);
  674.             ELSE
  675.                 vi$message ("Internal error while deleting!");
  676.             ENDIF;
  677.             POSITION (vi$start_pos);
  678.         ELSE
  679.             vi$abort (0);
  680.             POSITION (opos);
  681.         ENDIF;
  682.     ELSE
  683.         POSITION (opos);
  684.         vi$abort (0);
  685.     ENDIF;
  686.  
  687.     vi$check_length (olen);
  688. ENDPROCEDURE;
  689.  
  690. !
  691. !   This procedure checks a change in the size of the buffer, and reports
  692. !   the change if it is greater than the number set with ":set report"
  693. !
  694. PROCEDURE vi$check_length (olen)
  695.     LOCAL
  696.         nlen;
  697.  
  698.     nlen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
  699.  
  700.     IF (nlen - vi$report) >= olen THEN
  701.         vi$message (STR (nlen - olen) + " more lines!");
  702.     ELSE
  703.         IF (nlen + vi$report <= olen) THEN
  704.             vi$message (STR (olen - nlen) + " fewer lines!");
  705.         ENDIF;
  706.     ENDIF;
  707. ENDPROCEDURE;
  708.  
  709. !
  710. !   Perform the yank command tied to the 'y' key.
  711. !
  712. PROCEDURE vi$_yank (opchar, dest_buf)
  713.  
  714.     LOCAL
  715.         old_offset,
  716.         new_offset,
  717.         pos,
  718.         oline,
  719.         nline,
  720.         yank_range,
  721.         prog,
  722.         do_back,
  723.         nchar;
  724.  
  725.     ON_ERROR;
  726.         vi$message ("Error occured during yank, at line: "+STR(ERROR_LINE));
  727.         POSITION (vi$start_pos);
  728.         RETURN;
  729.     ENDON_ERROR;
  730.  
  731.     nchar := opchar;
  732.     pos := MARK (NONE);
  733.  
  734.     IF nchar = 0 THEN
  735.         nchar := vi$init_action (oline);
  736.     ENDIF;
  737.  
  738.     old_offset := -1;
  739.     new_offset := -1;
  740.  
  741.     ! If the movement will be backwards, then the region must not include
  742.     ! the current character.
  743.  
  744.     do_back := vi$get_direction (nchar);
  745.  
  746.     IF do_back THEN
  747.         old_offset := CURRENT_OFFSET;
  748.         vi$move_horizontal (-1);
  749.         new_offset := CURRENT_OFFSET;
  750.     ENDIF;
  751.  
  752.     vi$start_pos := MARK (NONE);
  753.  
  754.     ! For "yl" and similar moves, we must let vi$left to the movement.
  755.  
  756.     IF (INDEX (vi$weird2_moves, ASCII(nchar)) <> 0) AND
  757.                                                 (old_offset <> new_offset) THEN
  758.         MOVE_HORIZONTAL (1);
  759.     ENDIF;
  760.  
  761.     prog := vi$get_prog (nchar);
  762.  
  763.     IF prog <> "" THEN
  764.         vi$do_movement (prog, VI$YANK_TYPE);
  765.  
  766.         oline := vi$cur_line_no;
  767.         IF (vi$endpos <> 0) THEN
  768.             POSITION (vi$endpos);
  769.             nline := vi$abs (vi$cur_line_no - oline);
  770.             IF (nline >= vi$report) THEN
  771.                 vi$message (STR (nline) + " lines yanked");
  772.             ENDIF;
  773.             IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) AND
  774.                         (NOT do_back) AND
  775.                         (INDEX (vi$weird_moves, ASCII (nchar)) = 0) THEN
  776.                 MOVE_HORIZONTAL (-1);
  777.             ENDIF;
  778.  
  779.             yank_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);
  780.  
  781.             IF (yank_range <> 0) THEN
  782.                 IF (GET_INFO (dest_buf, "TYPE") = INTEGER) THEN
  783.                     vi$cur_text := vi$put2yank_buf (yank_range, vi$temp_buf);
  784.                 ELSE
  785.                     vi$cur_text := vi$put2yank_buf (yank_range, dest_buf);
  786.                 ENDIF;
  787.             ELSE
  788.                 vi$message ("Internal error while yanking!");
  789.             ENDIF;
  790.         ELSE
  791.             vi$abort (0);
  792.         ENDIF;
  793.  
  794.         POSITION (pos);
  795.     ELSE
  796.         vi$abort (0);
  797.     ENDIF;
  798.  
  799. ENDPROCEDURE;
  800.  
  801. !
  802. !   Return the absolute value of the value passed.
  803. !
  804. PROCEDURE vi$abs (val)
  805.     IF val < 0 THEN
  806.         RETURN (-val);
  807.     ENDIF;
  808.     RETURN (val);
  809. ENDPROCEDURE;
  810.  
  811. !
  812. !   Given a range of a buffer, or a string, place it into the "kill-ring"
  813. !   sliding the text back one slot that is already there.
  814. !
  815. PROCEDURE vi$put2del_buf (mode, string_parm)
  816.  
  817.     LOCAL
  818.         local_str,
  819.         pos;
  820.  
  821.     pos := MARK (NONE);
  822.  
  823.     IF (mode = VI$LINE_MODE) THEN
  824.  
  825.         ! Slide each range back one slot, throwing away the last.
  826.  
  827.         vi$mv2buf (vi$del_buf_8, vi$del_buf_9);
  828.         vi$mv2buf (vi$del_buf_7, vi$del_buf_8);
  829.         vi$mv2buf (vi$del_buf_6, vi$del_buf_7);
  830.         vi$mv2buf (vi$del_buf_5, vi$del_buf_6);
  831.         vi$mv2buf (vi$del_buf_4, vi$del_buf_5);
  832.         vi$mv2buf (vi$del_buf_3, vi$del_buf_4);
  833.         vi$mv2buf (vi$del_buf_2, vi$del_buf_3);
  834.         vi$mv2buf (vi$del_buf_1, vi$del_buf_2);
  835.  
  836.         ! Place the new text at the front.
  837.  
  838.         vi$type2buf (STR(mode), vi$del_buf_1);
  839.         vi$cp2buf (string_parm, vi$del_buf_1);
  840.     ENDIF;
  841.  
  842.     ! Save the text so that a normal 'p' or 'P' command also works.
  843.  
  844.     vi$type2buf (STR(mode), vi$temp_buf);
  845.     vi$cp2buf (string_parm, vi$temp_buf);
  846.  
  847.     POSITION (pos);
  848.     RETURN (vi$temp_buf);
  849. ENDPROCEDURE;
  850.  
  851. !
  852. !   Copy the text specified by source into the delete buffer given by
  853. !   dest.  If dest is zero, the it will be set to the value of a newly
  854. !   created buffer.
  855. !
  856. PROCEDURE vi$cp2buf (source, dest)
  857.     LOCAL
  858.         pos;
  859.  
  860.     pos := MARK (NONE);
  861.  
  862.     IF (source <> 0) THEN
  863.         IF (dest = 0) THEN
  864.             dest := vi$init_buffer ("TEMP_BUF_"+str(vi$temp_buf_num), "");
  865.             vi$temp_buf_num := vi$temp_buf_num + 1;
  866.         ENDIF;
  867.  
  868.         POSITION (dest);
  869.         COPY_TEXT (source);
  870.     ENDIF;
  871.  
  872.     POSITION (pos);
  873. ENDPROCEDURE;
  874.  
  875. !
  876. !   vi$mv2buf is like vi$cp2buf except that vi$mv2buf erases the buffer before
  877. !   performing the copy.
  878. !
  879. PROCEDURE vi$mv2buf (source, dest)
  880.     LOCAL
  881.         pos;
  882.  
  883.     pos := MARK (NONE);
  884.  
  885.     IF (source <> 0) THEN
  886.         IF (dest = 0) THEN
  887.             dest := vi$init_buffer ("TEMP_BUF_"+str(vi$temp_buf_num), "");
  888.             vi$temp_buf_num := vi$temp_buf_num + 1;
  889.         ELSE
  890.             ERASE (dest);
  891.         ENDIF;
  892.  
  893.         POSITION (dest);
  894.         COPY_TEXT (source);
  895.     ENDIF;
  896.  
  897.     POSITION (pos);
  898. ENDPROCEDURE;
  899.  
  900. !
  901. !   Given the string representation of either VI$LINE_MODE or VI$IN_LINE_MODE,
  902. !   place that text into the buffer given by dest.
  903. !
  904. PROCEDURE vi$type2buf (source, dest)
  905.     LOCAL
  906.         pos;
  907.  
  908.     pos := MARK (NONE);
  909.  
  910.     IF (source <> 0) THEN
  911.         IF (dest = 0) THEN
  912.             dest := vi$init_buffer ("TEMP_BUF_"+str(vi$temp_buf_num), "");
  913.             vi$temp_buf_num := vi$temp_buf_num + 1;
  914.         ELSE
  915.             ERASE (dest);
  916.         ENDIF;
  917.  
  918.         POSITION (BEGINNING_OF (dest));
  919.         COPY_TEXT (source);
  920.         SPLIT_LINE;
  921.     ENDIF;
  922.  
  923.     POSITION (pos);
  924. ENDPROCEDURE;
  925.  
  926. !
  927. !   Save a piece of yanked text including the mode that it was yanked.
  928. !
  929. PROCEDURE vi$put2yank_buf (string_parm, dest_buf)
  930.  
  931.     LOCAL
  932.         pos;
  933.  
  934.     pos := MARK (NONE);
  935.  
  936.     ! Set type of text in buffer.
  937.  
  938.     vi$type2buf (STR (vi$yank_mode), dest_buf);
  939.     vi$cp2buf (string_parm, dest_buf);
  940.     POSITION (pos);
  941.  
  942.     RETURN (dest_buf);
  943. ENDPROCEDURE;
  944.  
  945. !
  946. !   This is a debugging procedure used to view the contents of a buffer.
  947. !   It displays the buffer indicated by 'buf', and sets the status line
  948. !   of the window displayed to contain the text given by 'stat_line'.
  949. !
  950. PROCEDURE vi$show_buf (buf, stat_line)
  951.     LOCAL
  952.         this_key,
  953.         pos,
  954.         new_win;
  955.  
  956.     IF (GET_INFO (buf, "TYPE") <> BUFFER) THEN
  957.         vi$message ("show_buf called with non_buffer, message: "+stat_line);
  958.         RETURN;
  959.     ENDIF;
  960.  
  961.     pos := MARK (NONE);
  962.     new_win := CREATE_WINDOW (1, 23, ON);
  963.     MAP (new_win, buf);
  964.     POSITION (buf);
  965.     SET (STATUS_LINE, new_win, REVERSE, stat_line +
  966.                 ", BUFFER NAME: '"+GET_INFO (buf, "NAME")+"'");
  967.     vi$pos_in_middle (MARK (NONE));
  968.     UPDATE (new_win);
  969.     LOOP
  970.         vi$message ("Press RETURN to continue editing...");
  971.         this_key := READ_KEY;
  972.         EXITIF (this_key = RET_KEY);
  973.  
  974.         IF (this_key = CTRL_D_KEY) OR
  975.            (this_key = CTRL_U_KEY) OR
  976.            (this_key = CTRL_F_KEY) OR
  977.            (this_key = CTRL_B_KEY) OR
  978.            (this_key = KEY_NAME ('h')) OR
  979.            (this_key = KEY_NAME ('j')) OR
  980.            (this_key = KEY_NAME ('k')) OR
  981.            (this_key = KEY_NAME ('l')) THEN
  982.  
  983.             EXECUTE (LOOKUP_KEY (this_key, PROGRAM, vi$cmd_keys));
  984.             UPDATE (new_win);
  985.         ENDIF;
  986.     ENDLOOP;
  987.  
  988.     UNMAP (new_win);
  989.     DELETE (new_win);
  990.     POSITION (pos);
  991.     UPDATE (CURRENT_WINDOW);
  992. ENDPROCEDURE;
  993.  
  994. !
  995. !   This procedure moves the cursor down the number of lines indicated by
  996. !   vi$active count.  The parameter passed is used by delete and yank
  997. !   operations to differentiate them from normal cursor movement.
  998. !
  999. PROCEDURE vi$downline (adj)
  1000.  
  1001.     LOCAL
  1002.         pos,
  1003.         tabstops,
  1004.         cur_off,
  1005.         offset;
  1006.  
  1007.     !  Ignore error messages
  1008.  
  1009.     ON_ERROR
  1010.         vi$active_count := 0;
  1011.         POSITION (pos);
  1012.         RETURN (0);
  1013.     ENDON_ERROR;
  1014.  
  1015.     pos := MARK (NONE);
  1016.  
  1017.     MOVE_HORIZONTAL (-CURRENT_OFFSET);
  1018.     vi$start_pos := MARK (NONE);
  1019.  
  1020.     POSITION (pos);
  1021.  
  1022.     tabstops := GET_INFO (CURRENT_BUFFER, "TAB_STOPS");
  1023.  
  1024.     IF (GET_INFO (tabstops, "TYPE") <> STRING) THEN
  1025.         offset := CURRENT_OFFSET;
  1026.         cur_off := GET_INFO (SCREEN, "CURRENT_COLUMN") - 1;
  1027.         MOVE_VERTICAL (vi$cur_active_count + adj);
  1028.         MOVE_HORIZONTAL (-CURRENT_OFFSET);
  1029.         IF (vi$new_offset = 1) THEN
  1030.             vi$max_offset := cur_off;
  1031.             vi$new_offset := 0;
  1032.         ELSE
  1033.             IF (cur_off < vi$max_offset) THEN
  1034.                 cur_off := vi$max_offset;
  1035.             ENDIF;
  1036.         ENDIF;
  1037.  
  1038.         !  Save the beginning of the line as the new beginning.
  1039.  
  1040.         vi$new_endpos := MARK (NONE);
  1041.         vi$to_offset (CURRENT_LINE, cur_off, tabstops);
  1042.     ELSE
  1043.         MOVE_VERTICAL (vi$cur_active_count + adj);
  1044.     ENDIF;
  1045.  
  1046.     vi$yank_mode := VI$LINE_MODE;
  1047.     RETURN (vi$retpos (pos));
  1048. ENDPROCEDURE;
  1049.  
  1050. !
  1051. ! Move left one location.  Do not wrap at edge of the screen.
  1052. !
  1053. PROCEDURE vi$left
  1054.  
  1055.     LOCAL
  1056.         pos;
  1057.  
  1058.     !  Ignore error messages
  1059.  
  1060.     ON_ERROR
  1061.         vi$active_count := 0;
  1062.         POSITION (pos);
  1063.         RETURN (0);
  1064.     ENDON_ERROR;
  1065.  
  1066.     pos := MARK (NONE);
  1067.  
  1068.     vi$new_offset := 1;
  1069.     IF (CURRENT_OFFSET < vi$active_count) OR (CURRENT_OFFSET = 0) THEN
  1070.         vi$active_count := 0;
  1071.         RETURN (0);
  1072.     ENDIF;
  1073.  
  1074.     MOVE_HORIZONTAL (-vi$cur_active_count);
  1075.     vi$yank_mode := VI$IN_LINE_MODE;
  1076.     RETURN (vi$retpos (pos));
  1077. ENDPROCEDURE;
  1078.  
  1079. !
  1080. ! Move right one location.  Stop at the end of the line, but, do not
  1081. ! wrap at edge of the screen.
  1082. !
  1083. PROCEDURE vi$right
  1084.  
  1085.     LOCAL
  1086.         pos,
  1087.         line,
  1088.         offset;
  1089.  
  1090.     !  Ignore error messages
  1091.  
  1092.     ON_ERROR
  1093.         vi$active_count := 0;
  1094.         POSITION (pos);
  1095.         RETURN (0);
  1096.     ENDON_ERROR
  1097.  
  1098.     pos := MARK (NONE);
  1099.  
  1100.     line := CURRENT_LINE;
  1101.     offset := CURRENT_OFFSET;
  1102.  
  1103.     ! This makes it possible to use the "s" command at the end of the line.
  1104.  
  1105.     IF (vi$command_type = VI$CHANGE_TYPE) THEN
  1106.         offset := offset - 1;
  1107.         IF (LENGTH (CURRENT_LINE) = 0) THEN
  1108.             COPY_TEXT (" ");
  1109.             MOVE_HORIZONTAL (-1);
  1110.             vi$start_pos := MARK (NONE);
  1111.         ENDIF;
  1112.     ENDIF;
  1113.  
  1114.     IF (vi$active_count < (LENGTH (line) - offset -
  1115.                                     (vi$command_type = VI$OTHER_TYPE))) THEN
  1116.         MOVE_HORIZONTAL (vi$cur_active_count);
  1117.     ELSE
  1118.         vi$active_count := 0;
  1119.         RETURN (0);
  1120.     ENDIF;
  1121.  
  1122.     vi$new_offset := 1;
  1123.  
  1124.     vi$yank_mode := VI$IN_LINE_MODE;
  1125.     RETURN (vi$retpos (pos));
  1126. ENDPROCEDURE;
  1127.  
  1128. !
  1129. ! Move up one row, staying in the same column.  Scroll if necessary.
  1130. !
  1131. PROCEDURE vi$upline
  1132.  
  1133.     LOCAL
  1134.         pos,
  1135.         tabstops,
  1136.         offset,
  1137.         cur_off;
  1138.  
  1139.     !  Ignore error messages
  1140.  
  1141.     ON_ERROR
  1142.         vi$active_count := 0;
  1143.         POSITION (pos);
  1144.         RETURN (0);
  1145.     ENDON_ERROR;
  1146.  
  1147.     pos := MARK (NONE);
  1148.  
  1149.     tabstops := GET_INFO (CURRENT_BUFFER, "TAB_STOPS");
  1150.  
  1151.     MOVE_HORIZONTAL (-CURRENT_OFFSET);
  1152.     MOVE_HORIZONTAL (LENGTH(vi$current_line) + 1);
  1153.     vi$new_endpos := MARK(NONE);
  1154.  
  1155.     POSITION (pos);
  1156.  
  1157.     ! We must understand it (i.e. it must be an integer) inorder to process
  1158.     ! the tabs properly.
  1159.  
  1160.     IF (GET_INFO (tabstops, "TYPE") <> STRING) THEN
  1161.         offset := CURRENT_OFFSET;
  1162.  
  1163.         cur_off := GET_INFO (SCREEN, "CURRENT_COLUMN") - 1;
  1164.         MOVE_VERTICAL(-vi$cur_active_count);
  1165.         MOVE_HORIZONTAL (-CURRENT_OFFSET);
  1166.  
  1167.         IF vi$new_offset = 1 THEN
  1168.             vi$max_offset := cur_off;
  1169.             vi$new_offset := 0;
  1170.         ENDIF;
  1171.  
  1172.         IF (cur_off < vi$max_offset) THEN
  1173.             cur_off := vi$max_offset;
  1174.         ENDIF;
  1175.  
  1176.         !  Save the beginning of the line as the new beginning.
  1177.  
  1178.         vi$start_pos := MARK (NONE);
  1179.         vi$to_offset (CURRENT_LINE, cur_off, tabstops);
  1180.     ELSE
  1181.         MOVE_VERTICAL (-vi$cur_active_count);
  1182.     ENDIF;
  1183.     vi$yank_mode := VI$LINE_MODE;
  1184.     RETURN (vi$retpos (pos));
  1185. ENDPROCEDURE;
  1186.  
  1187. !
  1188. !   Move the cursor to the offset given by 'offset' counting tabs as expanded
  1189. !   spaces.
  1190. !
  1191. PROCEDURE vi$to_offset (line, offset, tabstops)
  1192.     LOCAL
  1193.         cur_ch,
  1194.         col,
  1195.         diff,
  1196.         len,
  1197.         tab,
  1198.         idx;
  1199.  
  1200.     idx := 1;
  1201.     col := 0;
  1202.     len := LENGTH (line);
  1203.     tab := ASCII (9);
  1204.  
  1205.     LOOP
  1206.         EXITIF (len < idx) OR (col >= offset);
  1207.         IF (SUBSTR (line, idx, 1) = tab) THEN
  1208.             diff := (((col+tabstops)/tabstops)*tabstops)-col;
  1209.         ELSE
  1210.             diff := 1;
  1211.         ENDIF;
  1212.         col := col + diff;
  1213.         idx := idx + 1;
  1214.     ENDLOOP;
  1215.  
  1216.     !  Move N characters to the right.
  1217.  
  1218.     MOVE_HORIZONTAL (idx - 1);
  1219. ENDPROCEDURE;
  1220.  
  1221. !
  1222. !   Search for a text string.  This procedure is activated by typing
  1223. !   either a '/' or a '?'.
  1224. !
  1225. PROCEDURE vi$search (direction)
  1226.     LOCAL
  1227.         where,
  1228.         i,
  1229.         pos,
  1230.         ch,
  1231.         sstr,
  1232.         cnt,
  1233.         add_spec,
  1234.         prompt;
  1235.  
  1236.     pos := MARK (NONE);
  1237.  
  1238.     IF (direction > 0) THEN
  1239.         prompt := "/";
  1240.     ELSE
  1241.         prompt := "?";
  1242.     ENDIF;
  1243.  
  1244.     IF (vi$read_a_line (prompt, sstr) = 0) THEN
  1245.         RETURN (0);
  1246.     ENDIF;
  1247.  
  1248.     i := 1;
  1249.     LOOP
  1250.         EXITIF (i > LENGTH (sstr));
  1251.         ch := SUBSTR (sstr, i, 1);
  1252.         IF (ch = "\") THEN
  1253.             i := i + 1;
  1254.         ELSE
  1255.             EXITIF (ch = prompt);
  1256.         ENDIF;
  1257.         i := i + 1;
  1258.     ENDLOOP;
  1259.  
  1260.     add_spec := 0;
  1261.     IF (ch = prompt) THEN
  1262.         add_spec := SUBSTR (sstr, i+1, 255);
  1263.         sstr := SUBSTR (sstr, 1, i-1);
  1264.         MESSAGE("add_spec: "+add_spec);
  1265.         MESSAGE("sstr: "+sstr);
  1266.     ENDIF;
  1267.  
  1268.     IF (direction > 0) THEN
  1269.         SET (FORWARD, CURRENT_BUFFER);
  1270.         vi$last_search_dir := 1;
  1271.         MOVE_HORIZONTAL (1);
  1272.     ELSE
  1273.         SET (REVERSE, CURRENT_BUFFER);
  1274.         vi$last_search_dir := -1;
  1275.     ENDIF;
  1276.  
  1277.     IF sstr <> "" THEN
  1278.         vi$search_string := sstr;
  1279.     ELSE
  1280.         IF vi$search_string = 0 THEN
  1281.             vi$message ("No previous string to search for!");
  1282.             POSITION (pos);
  1283.             RETURN (0);
  1284.         ENDIF;
  1285.     ENDIF;
  1286.  
  1287.     ! On success then return the position we moved to.
  1288.  
  1289.     cnt := vi$cur_active_count;
  1290.     LOOP
  1291.         where := vi$find_str (vi$search_string, 0);
  1292.         EXITIF (where = 0);
  1293.         POSITION (BEGINNING_OF (where));
  1294.         IF (CURRENT_DIRECTION = FORWARD) THEN
  1295.             MOVE_HORIZONTAL (1);
  1296.         ELSE
  1297.             MOVE_HORIZONTAL (-1);
  1298.         ENDIF;
  1299.         cnt := cnt - 1;
  1300.         EXITIF cnt = 0;
  1301.     ENDLOOP;
  1302.  
  1303.     IF (where = 0) THEN
  1304.         vi$message ("String not found");
  1305.     ELSE
  1306.         IF add_spec <> 0 THEN
  1307.             POSITION (where);
  1308.             IF add_spec = "-" THEN
  1309.                 add_spec := "-1";
  1310.             ELSE
  1311.                 IF (SUBSTR (add_spec, 1, 1) = "+") THEN
  1312.                     IF (add_spec = "+") THEN
  1313.                         add_spec := "1";
  1314.                     ENDIF;
  1315.                 ELSE
  1316.                     add_spec := SUBSTR (add_spec, 2, 255);
  1317.                 ENDIF;
  1318.             ENDIF;
  1319.  
  1320.             i := INT (add_spec);
  1321.             MOVE_VERTICAL (i);
  1322.             vi$_bol;
  1323.             where := MARK (NONE);
  1324.         ENDIF;
  1325.         MESSAGE ("");
  1326.     ENDIF;
  1327.  
  1328.     POSITION (pos);
  1329.     RETURN (where);
  1330. ENDPROCEDURE;
  1331.  
  1332. !
  1333. !   Search for the next occurence of the previously searched for string.
  1334. !   The procedure is actived by typing an 'n' or 'N' keystroke.
  1335. !
  1336. PROCEDURE vi$search_next (direction)
  1337.     LOCAL
  1338.         prompt,
  1339.         where,
  1340.         pos,
  1341.         cnt,
  1342.         sstr;
  1343.  
  1344.     pos := MARK (NONE);
  1345.  
  1346.     IF vi$search_string = 0 THEN
  1347.         vi$message ("No previous string to search for!");
  1348.         POSITION (pos);
  1349.         RETURN (0);
  1350.     ENDIF;
  1351.  
  1352.     IF (direction > 0) THEN
  1353.         prompt := "/" + vi$search_string;
  1354.         SET (FORWARD, CURRENT_BUFFER);
  1355.         IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
  1356.             MOVE_HORIZONTAL (1);
  1357.         ELSE
  1358.             IF (vi$wrap_scan = 1) THEN
  1359.                 POSITION (BEGINNING_OF (CURRENT_BUFFER));
  1360.             ENDIF;
  1361.         ENDIF;
  1362.     ELSE
  1363.         prompt := "?" + vi$search_string;
  1364.         SET (REVERSE, CURRENT_BUFFER);
  1365.         IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
  1366.             IF (SUBSTR (prompt, 1, 3) = "?\<") THEN
  1367.                 MOVE_HORIZONTAL (-2);
  1368.             ELSE
  1369.                 MOVE_HORIZONTAL (-1);
  1370.             ENDIF;
  1371.         ELSE
  1372.             IF (vi$wrap_scan = 1) THEN
  1373.                 POSITION (END_OF (CURRENT_BUFFER));
  1374.             ENDIF;
  1375.         ENDIF;
  1376.     ENDIF;
  1377.  
  1378.     vi$message (prompt);
  1379.  
  1380.     ! On success then return the position we moved to.
  1381.  
  1382.     cnt := vi$cur_active_count;
  1383.     LOOP
  1384.         where := vi$find_str (vi$search_string, 0);
  1385.         EXITIF (where = 0);
  1386.         POSITION (BEGINNING_OF (where));
  1387.         IF (CURRENT_DIRECTION = FORWARD) THEN
  1388.             MOVE_HORIZONTAL (1);
  1389.         ELSE
  1390.             MOVE_HORIZONTAL (-1);
  1391.         ENDIF;
  1392.         cnt := cnt - 1;
  1393.         EXITIF cnt = 0;
  1394.     ENDLOOP;
  1395.  
  1396.     IF (where = 0) THEN
  1397.         vi$message ("String not found");
  1398.     ELSE
  1399.         vi$message ("");
  1400.     ENDIF;
  1401.  
  1402.     POSITION (pos);
  1403.     RETURN (where);
  1404. ENDPROCEDURE;
  1405.  
  1406. !
  1407. !   This procedure can be used to find a string of text (using RE's).
  1408. !   The current direction of the BUFFER is used to determine which way
  1409. !   the search goes.  'replace' is used by the replace code to indicate
  1410. !   that wrap scan should be performed.
  1411. !
  1412. PROCEDURE vi$find_str (sstr, replace)
  1413.     LOCAL
  1414.         pos,
  1415.         new_pat,
  1416.         start,
  1417.         where;
  1418.  
  1419.     ON_ERROR
  1420.     ENDON_ERROR;
  1421.  
  1422.     pos := MARK (NONE);
  1423.     IF vi$magic THEN
  1424.         new_pat := vi$re_pattern_gen (sstr);
  1425.     ELSE
  1426.         new_pat := vi$pattern_gen (sstr);
  1427.     ENDIF;
  1428.  
  1429.     IF (new_pat <> 0) THEN
  1430.         EXECUTE (COMPILE ("vi$_find_pat := " + new_pat));
  1431.         where := SEARCH (vi$_find_pat, CURRENT_DIRECTION, vi$ignore_case);
  1432.         IF (where = 0) AND (vi$wrap_scan = 1) AND (replace = 0) THEN
  1433.             IF (CURRENT_DIRECTION = FORWARD) THEN
  1434.                 POSITION (BEGINNING_OF (CURRENT_BUFFER));
  1435.             ELSE
  1436.                 POSITION (END_OF (CURRENT_BUFFER));
  1437.             ENDIF;
  1438.             where := SEARCH (vi$_find_pat, CURRENT_DIRECTION, vi$ignore_case);
  1439.         ENDIF;
  1440.     ELSE
  1441.         where := 0;
  1442.     ENDIF;
  1443.  
  1444.     IF (where <> 0) AND (vi$in_ws) THEN
  1445.         POSITION (BEGINNING_OF (where));
  1446.         IF (CURRENT_OFFSET <> 0) OR
  1447.                                 (INDEX (vi$_ws, CURRENT_CHARACTER) <> 0) THEN
  1448.             MOVE_HORIZONTAL (1);
  1449.         ENDIF;
  1450.         start := MARK (NONE);
  1451.         POSITION (END_OF (where));
  1452.         IF (CURRENT_OFFSET <> LENGTH (CURRENT_LINE)) THEN
  1453.             MOVE_HORIZONTAL (-1);
  1454.         ENDIF;
  1455.         where := CREATE_RANGE (start, MARK (NONE), NONE);
  1456.         POSITION (pos);
  1457.     ENDIF;
  1458.     RETURN (where);
  1459. ENDPROCEDURE;
  1460.  
  1461. !
  1462. !   Generate a TPU pattern string, not using RE's, i.e. :set nomagic is
  1463. !   in effect when this routine is used.
  1464. !
  1465. PROCEDURE vi$pattern_gen (pat)
  1466.  
  1467.     LOCAL
  1468.         first,      ! First pattern to be done
  1469.         part_pat,
  1470.         chno,
  1471.         startchar,
  1472.         haveany,
  1473.         regular,
  1474.         tstr,
  1475.         endchar,
  1476.         str_pat,
  1477.         cur_pat,    ! The current pattern to be extracted
  1478.         cur_char,   ! The current character in the regular
  1479.                     ! expression being examined
  1480.         new_pat,    ! The output pattern
  1481.         pos;        ! The position within the regular
  1482.                     ! expression string that we are examining
  1483.                     ! currently
  1484.  
  1485.     IF (INDEX (pat, "$") <> 0) OR (INDEX (pat, "^") <> 0) THEN
  1486.         new_pat := "";
  1487.     ELSE
  1488.         new_pat := '"'+pat+'"';
  1489.         RETURN (new_pat);
  1490.     ENDIF;
  1491.  
  1492.     pos := 1;
  1493.  
  1494.     IF SUBSTR (pat, pos, 1) = "^" THEN
  1495.         IF LENGTH (pat > 1) THEN
  1496.             new_pat := "line_begin & '";
  1497.         ELSE
  1498.             new_pat := "line_begin";
  1499.         ENDIF;
  1500.         pos := pos + 1;
  1501.     ENDIF;
  1502.  
  1503.     LOOP
  1504.         EXITIF (pos > LENGTH (pat));
  1505.  
  1506.         regular := 0;
  1507.         cur_pat := "";
  1508.         cur_char := substr (pat, pos, 1);
  1509.  
  1510.         IF (cur_char = "$") AND (pos+1 >= LENGTH (pat)) THEN
  1511.             IF pos <> 1 THEN
  1512.                 cur_pat := "' & line_end";
  1513.             ELSE
  1514.                 cur_pat := "line_end";
  1515. $$EOD$$
  1516.