[comp.sources.misc] VI in TPU part 6/13

gregg@a.cs.okstate.edu@mandrill.CWRU.Edu (Gregg Wonderly) (10/13/87)

$ WRITE SYS$OUTPUT "Creating ""VI.5"""
$ CREATE VI.5
$ DECK/DOLLARS=$$EOD$$
        ENDIF;
        RETURN;
    ENDIF;

    IF (key = TAB_KEY) THEN
         key := ASCII (9);
    ELSE
        IF (key = RET_KEY) THEN
             key := ASCII (13);
        ELSE
            IF (key = DEL_KEY) THEN
                 key := ASCII (8);
            ELSE
                key := ASCII (key);
            ENDIF;
        ENDIF;
    ENDIF;

    IF ((CURRENT_OFFSET + act_cnt) <= LENGTH (vi$current_line)) THEN
        IF (key = ASCII (13)) THEN
            MOVE_HORIZONTAL (act_cnt);
        ELSE
            MOVE_HORIZONTAL (act_cnt - 1);
        ENDIF;
        vi$save_for_undo (CREATE_RANGE (pos, MARK(NONE), NONE),
                                                        VI$IN_LINE_MODE, 1);
        IF (key = ASCII (13)) THEN
            MOVE_HORIZONTAL (-act_cnt);
        ELSE
            MOVE_HORIZONTAL (-(act_cnt-1));
        ENDIF;
        IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
            MOVE_HORIZONTAL (-1);
            vi$undo_start := MARK (NONE);
            MOVE_HORIZONTAL (1);
        ELSE
            vi$undo_start := 0;
        ENDIF;

        SET (OVERSTRIKE, CURRENT_BUFFER);
        LOOP
            IF (key = ASCII (13)) THEN
                SPLIT_LINE;
                ERASE_CHARACTER (1);
            ELSE
                COPY_TEXT (key);
            ENDIF;
            act_cnt := act_cnt - 1;
            EXITIF act_cnt = 0;
        ENDLOOP;

        IF (key = ASCII (13)) THEN
            MOVE_HORIZONTAL (1);
        ENDIF;

        MOVE_HORIZONTAL (-1);
        vi$undo_end := MARK (NONE);

        SET (INSERT, CURRENT_BUFFER);
        IF (vi$undo_start = 0) THEN
            vi$undo_start := BEGINNING_OF (CURRENT_BUFFER);
        ELSE
            pos := MARK (NONE);
            POSITION (vi$undo_start);
            MOVE_HORIZONTAL (1);
            vi$undo_start := MARK (NONE);
            POSITION (pos);
        ENDIF;
    ELSE
        POSITION (pos);
    ENDIF;

    IF (vi$show_mode) THEN
        MESSAGE ("");
    ENDIF;
    RETURN;
ENDPROCEDURE

!
!   Perform the 'R' command
!
PROCEDURE vi$_replace_str

    LOCAL
        replace,
        max_mark,
        start_pos,
        spos,
        pos,
        max_col;

    pos := MARK (NONE);
    max_col := CURRENT_OFFSET;
    start_pos := max_col;
    MOVE_HORIZONTAL (LENGTH (CURRENT_LINE) - CURRENT_OFFSET);
    max_mark := MARK(NONE);
    vi$undo_end := MARK (NONE);
    POSITION (pos);
    vi$update (CURRENT_WINDOW);
    replace := CURRENT_LINE;
    spos := vi$get_undo_start;
    vi$save_for_undo (CREATE_RANGE (pos, max_mark, NONE), VI$IN_LINE_MODE, 1);

    vi$line_edit (max_col, start_pos, max_mark, replace);
    pos := MARK (NONE);
    vi$undo_start := vi$set_undo_start (spos);
    POSITION (pos);
ENDPROCEDURE;

!
!   As in REAL vi, this procedure does not recognize a repeat count.
!   A simple loop would make it possible to use the repeat count contained
!   in "vi$active_count".  A macro is used so that all of the crap for undo
!   need not be placed here.
!
PROCEDURE vi$_change_case
    LOCAL
        pos;

    vi$active_count := 0;
    pos := INDEX (vi$_lower_chars, CURRENT_CHARACTER);
    IF pos <> 0 THEN
        vi$do_macro ("r"+SUBSTR (vi$_upper_chars, pos, 1)+"l", 0);
    ELSE
        pos := INDEX (vi$_upper_chars, CURRENT_CHARACTER);
        IF pos <> 0 THEN
            vi$do_macro ("r"+SUBSTR (vi$_lower_chars, pos, 1)+"l", 0);
        ELSE
            vi$kill_undo;
            vi$undo_end := 0;
            MOVE_HORIZONTAL (1);
        ENDIF;
    ENDIF;

ENDPROCEDURE;

!
!
!
PROCEDURE vi$init_action (olen)
    LOCAL
        nchar;

    olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");

    IF (vi$select_pos = 0) THEN
        nchar := vi$read_a_key;
        IF (INDEX ("123456789", ASCII(nchar)) <> 0) THEN
            vi$active_count := INDEX (vi$_numeric_chars, ASCII(nchar)) - 1;
            LOOP
                nchar := vi$read_a_key;
                EXITIF (INDEX (vi$_numeric_chars, ASCII(nchar)) = 0);
                vi$active_count := vi$active_count *
                        10 + (INDEX (vi$_numeric_chars, ASCII (nchar)) - 1);
            ENDLOOP;
        ENDIF;
    ELSE
        nchar := KEY_NAME (".");
    ENDIF;
    RETURN (nchar);
ENDPROCEDURE;

!
!
!
PROCEDURE vi$get_prog (nchar)
    IF (vi$select_pos = 0) THEN
        RETURN (LOOKUP_KEY (KEY_NAME (nchar), COMMENT, vi$move_keys));
    ELSE
        RETURN ("vi$get_select_pos");
    ENDIF;
ENDPROCEDURE;

!
!
!
PROCEDURE vi$do_movement (prog, mtype)

    vi$endpos := 0;
    vi$new_endpos := 0;
    vi$command_type := mtype;

    EXECUTE (COMPILE ("vi$endpos := " + prog));
    IF vi$new_endpos <> 0 THEN
        vi$endpos := vi$new_endpos;
    ENDIF;
ENDPROCEDURE;

!
!   Perform the operations associated with the 'c' command.
!
PROCEDURE vi$_change

    LOCAL
        max_mark,
        max_col,
        start_col,
        start_offset,
        end_offset,
        start_line,
        end_line,
        cha_range,
        pos,
        olen,
        prog,
        do_back,
        nchar;

    ON_ERROR;
        vi$message ("Error occured during change, at line: "+STR(ERROR_LINE));
        POSITION (vi$start_pos);
        RETURN;
    ENDON_ERROR;

    vi$new_offset := 1;
    nchar := vi$init_action (olen);

    IF (nchar = KEY_NAME ('c')) THEN
        vi$_big_s;
        RETURN;
    ENDIF;

    ! If the movement will be backwards, then the region must not include
    ! the current character.

    do_back := vi$get_direction (nchar);

    IF do_back THEN
        vi$move_horizontal (-1);
        vi$start_pos := MARK (NONE);
        vi$move_horizontal (1);
    ELSE
        vi$start_pos := MARK (NONE);
    ENDIF;

    prog := vi$get_prog (nchar);

    IF prog <> "" THEN
        vi$do_movement (prog, VI$CHANGE_TYPE);

        POSITION (vi$start_pos);
        start_offset := CURRENT_OFFSET;
        MOVE_HORIZONTAL (-CURRENT_OFFSET);
        start_line := MARK (NONE);
        POSITION (vi$start_pos);

        IF (vi$endpos <> 0) THEN
            POSITION (vi$endpos);
            MOVE_HORIZONTAL (-CURRENT_OFFSET);
            end_line := MARK (NONE);
            POSITION (vi$endpos);

            IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) AND
                        (NOT do_back) AND
                        (INDEX (vi$weird_moves, ASCII (nchar)) = 0) THEN
                vi$move_horizontal (-1);
            ENDIF;
            end_offset := CURRENT_OFFSET + 1;

            cha_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);

            IF (start_line <> end_line) THEN
                IF (cha_range <> 0) THEN
                    POSITION (vi$start_pos);

                    vi$undo_start := vi$get_undo_start;

                    vi$save_for_undo (cha_range, vi$yank_mode, 0);
                    ERASE (cha_range);

                    IF (vi$while_not_esc = 0) THEN
                        vi$undo_end := 0;
                    ELSE
                        vi$undo_end := MARK (NONE);
                        vi$undo_start := vi$set_undo_start (vi$undo_start);
                        POSITION (vi$undo_end);
                    ENDIF;
                ELSE
                    vi$message ("Internal error while changing!");
                ENDIF;
            ELSE
                IF (cha_range <> 0) THEN
                    IF (start_offset < end_offset) THEN
                        max_col := end_offset;
                        MOVE_HORIZONTAL (1);
                        max_mark := MARK (NONE);
                        MOVE_HORIZONTAL (-1);
                        start_col := start_offset;
                    ELSE
                        POSITION (vi$start_pos);
                        MOVE_HORIZONTAL (1);
                        max_col := CURRENT_OFFSET;
                        max_mark := MARK (NONE);
                        POSITION (vi$start_pos);
                        start_col := end_offset - 1;
                    ENDIF;

                    vi$save_for_undo (SUBSTR (vi$current_line, start_col + 1,
                            max_col - start_col), vi$yank_mode, 0);

                    SET (OVERSTRIKE, CURRENT_BUFFER);
                    COPY_TEXT ("$");
                    SET (INSERT, CURRENT_BUFFER);

                    IF (start_offset < end_offset) THEN
                        POSITION (vi$start_pos);
                    ELSE
                        POSITION (vi$endpos);
                    ENDIF;

                    vi$update (CURRENT_WINDOW);

                    vi$undo_start := vi$get_undo_start;

                    if (vi$line_edit (max_col, start_col, max_mark, 0) = 0) THE
N
                        vi$undo_end := 0;
                        IF (start_col <> 0) THEN
                            MOVE_HORIZONTAL (1);
                        ENDIF;
                    ELSE
                        IF (CURRENT_OFFSET = 0) THEN
                            MOVE_HORIZONTAL (-1);
                            vi$undo_end := MARK (NONE);
                            MOVE_HORIZONTAL (1);
                        ELSE
                            vi$undo_end := MARK (NONE);
                        ENDIF;
                    ENDIF;

                    pos := MARK (NONE);

                    vi$undo_start := vi$set_undo_start (vi$undo_start);
                    POSITION (pos);
                ELSE
                    vi$message ("Internal error while changing!");
                ENDIF;
            ENDIF;
        ELSE
            vi$abort (0);
        ENDIF;
    ELSE
        vi$abort (0);
    ENDIF;

    vi$check_length (olen);
ENDPROCEDURE;

!
!   Decide which direction the movement will be based on whether or not
!   the last movement was a t, T, f, F, or other backward movement.
!
PROCEDURE vi$get_direction (nchar)
    LOCAL
        do_back;

    do_back := 0;

    IF ((ASCII (nchar) = ",") AND ((vi$last_s_func = "vi$find_char") OR
                                        (vi$last_s_func = "vi$to_char"))) OR
        ((ASCII (nchar) = ";") AND ((vi$last_s_func = "vi$back_find_char") OR
                                    (vi$last_s_func = "vi$back_to_char"))) THEN
        do_back := 1;
    ENDIF;

    IF (INDEX (vi$back_moves + vi$weird2_moves, ASCII(nchar)) <> 0) THEN
        do_back := 1;
    ENDIF;

    RETURN (do_back);
ENDPROCEDURE;

!
!   Given the fact that a select range is active, modify vi$start_pos
!   to be the start of that range, and return the end of the select
!   range.
!
PROCEDURE vi$get_select_pos
    LOCAL
        pos,
        rng;

    rng := SELECT_RANGE;
    IF (rng <> 0) THEN
        pos := MARK (NONE);
        vi$select_pos := 0;
        vi$start_pos := BEGINNING_OF (rng);
        POSITION (END_OF (rng));
        MOVE_HORIZONTAL (1);
        RETURN (vi$retpos (pos));
    ELSE
        vi$select_pos := 0;
        vi$message ("No region selected!");
    ENDIF;
    RETURN (0);
ENDPROCEDURE;

!
!   Perform the operations associated with the 'S' command.
!
PROCEDURE vi$_big_s
    LOCAL
        max_mark,
        start_pos,
        max_col,
        rng,
        start,
        end,
        pos;

    MOVE_HORIZONTAL (-CURRENT_OFFSET);
    MOVE_HORIZONTAL (-1);
    vi$undo_start := MARK (NONE);
    MOVE_HORIZONTAL (1);

    IF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) THEN
        vi$undo_end := 0;
    ENDIF;

    start := MARK (NONE);
    IF (LENGTH (vi$current_line) > 0) THEN
        MOVE_VERTICAL (vi$cur_active_count - 1);
        MOVE_HORIZONTAL (LENGTH (vi$current_line) - 1);
    ENDIF;

    end := MARK (NONE);
    rng := CREATE_RANGE (start, end, NONE);
    POSITION (start);
    vi$save_for_undo (rng, VI$IN_LINE_MODE, 1);

    ERASE (rng);

    max_col := CURRENT_OFFSET;
    start_pos := max_col;
    max_mark := MARK(NONE);

    vi$update (CURRENT_WINDOW);

    IF (vi$line_edit (max_col, start_pos, max_mark, 0) <> 0) THEN
        vi$undo_end := MARK (NONE);
    ELSE
        vi$undo_end := 0;
    ENDIF;
    pos := MARK (NONE);
    vi$undo_start := vi$set_undo_start (vi$undo_start);
    POSITION (pos);
ENDPROCEDURE;

!
!   This function performs the operations associated with the '"' command
!   that allows one of the 26 named buffers, or one of the 10 delete
!   buffers to be the target of a 'd', 'D', 'x', 'X', 'y', 'Y', 'p' or 'P'
!   command.
!
PROCEDURE vi$select_buffer
    LOCAL
        numeric,
        asc_action,
        action,
        prog,
        buf_name,
        nchar;

    ON_ERROR;
        RETURN;
    ENDON_ERROR;

    nchar := vi$read_a_key;
    action := vi$read_a_key;
    asc_action := ASCII (action);
    numeric := (INDEX (vi$_numeric_chars, asc_action) <> 0);

    IF numeric THEN
        vi$active_count := INDEX (vi$_numeric_chars, asc_action) - 1;
        LOOP
            action := vi$read_a_key;
            asc_action := ASCII (action);
            EXITIF (INDEX (vi$_numeric_chars, asc_action) = 0);
            vi$active_count := (vi$active_count * 10) +
                                    (INDEX (vi$_numeric_chars, asc_action) - 1)
;
        ENDLOOP;
    ENDIF;

    IF  (asc_action <> 'P') AND (asc_action <> 'p') AND (asc_action <> 'd') AND
        (asc_action <> 'D') AND (asc_action <> 'y') AND (asc_action <> 'Y') AND
        (asc_action <> 'x') AND (asc_action <> 'X') AND (NOT numeric) THEN

        vi$message ("Unrecognized buffer action, ignoring: '"+asc_action+"'");

        RETURN;
    ENDIF;

    IF (INDEX ("123456789", ASCII(nchar)) <> 0) THEN

        IF  (asc_action <> 'P') AND (asc_action <> 'p') THEN
            RETURN;
        ENDIF;

        ! Selected a deletion buffer.

        buf_name := "vi$del_buf_"+ASCII(nchar);

    ELSE
        IF (INDEX (vi$_letter_chars, ASCII(nchar)) <> 0) THEN

            ! Selected a named buffer.

            IF (INDEX (vi$_upper_chars, ASCII(nchar)) <> 0) THEN
                nchar := SUBSTR (vi$_lower_chars,
                            INDEX (vi$_upper_chars, ASCII(nchar)), 1);
            ENDIF;

            buf_name := "vi$ins_buf_"+ASCII(nchar);

            ! Only create a buffer if we are going to put something into it.

            IF  (asc_action <> 'P') AND (asc_action <> 'p') THEN
                EXECUTE (COMPILE ('vi$get_ins_buf(' +
                                            buf_name + ', "'+buf_name+'");'));
            ELSE
                vi$global_var := 0;
                EXECUTE (COMPILE ("vi$global_var:="+buf_name));
                IF (vi$global_var = 0) THEN
                    MESSAGE ("There is nothing in that buffer!");
                    RETURN;
                ENDIF;
            ENDIF;
        ELSE
            vi$message ("Invalid buffer!");
            RETURN;
        ENDIF;
    ENDIF;

    ! We now have a buffer, and the next command key, so envoke the
    ! proper code.

    vi$do_buf_act (asc_action, 'P', "vi$put_here (VI$HERE, "+buf_name+");");
    vi$do_buf_act  (asc_action, 'p', "vi$put_after ("+buf_name+");");
    vi$do_buf_act  (asc_action, 'd', "vi$_delete (0, "+buf_name+");");
    vi$do_buf_act  (asc_action, 'D',
                                "vi$_delete (KEY_NAME('$'), "+buf_name+");");
    vi$do_buf_act  (asc_action, 'x', "vi$_delete ('l', "+buf_name+");");
    vi$do_buf_act  (asc_action, 'X', "vi$_delete ('h', "+buf_name+");");
    vi$do_buf_act  (asc_action, 'y', "vi$_yank (0, "+buf_name+");");
    vi$do_buf_act  (asc_action, 'Y', "vi$_yank ('y', "+buf_name+");");
    vi$do_buf_act  (asc_action, 'Y', "vi$_yank (KEY_NAME('y'), "+buf_name+");")
;
ENDPROCEDURE;

!
!   Perform action based on key typed and passed data
!
PROCEDURE vi$do_buf_act (act_type, look_for, what_to_do)

    IF (act_type = look_for) THEN
        EXECUTE (COMPILE (what_to_do));
    ENDIF;
ENDPROCEDURE;

!
!   Create a buffer named 'bname' providing that there is not already a
!   buffer by that name.
!
PROCEDURE vi$get_ins_buf (buf, bname)

    IF (buf = 0) THEN
        buf := vi$init_buffer (bname, "");
    ENDIF;

    IF buf = 0 THEN
        vi$message ("Error creating named buffer!");
    ENDIF;
ENDPROCEDURE;

!
!   Perform the delete command tied to the 'd' key.
!
PROCEDURE vi$_delete (opchar, dest_buf)

    LOCAL
        olen,
        old_offset,
        new_offset,
        era_range,
        opos,
        prog,
        do_back,
        nchar;

    ON_ERROR;
        vi$message ("Error occured during delete, at line: "+STR(ERROR_LINE));
        POSITION (vi$start_pos);
        RETURN;
    ENDON_ERROR;

    vi$new_offset := 1;
    nchar := opchar;

    opos := MARK (NONE);
    IF (nchar = 0) THEN
        nchar := vi$init_action (olen);
    ELSE
        olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
    ENDIF;

    ! If the movement will be backwards, then the region must not include
    ! the current character.

    old_offset := -1;
    new_offset := -1;

    do_back := vi$get_direction (nchar);

    IF do_back THEN
        old_offset := CURRENT_OFFSET;
        vi$move_horizontal (-1);
        new_offset := CURRENT_OFFSET;
    ENDIF;

    vi$start_pos := MARK (NONE);

    ! For "dh" or "X" (a macro of "dh"), we must let vi$left do the movement.

    IF (INDEX (vi$weird2_moves, ASCII(nchar)) <> 0) AND
                                                (old_offset <> new_offset) THEN
        MOVE_HORIZONTAL (1);
    ENDIF;

    prog := vi$get_prog (nchar);

    IF prog <> "" THEN
        vi$do_movement (prog, VI$DELETE_TYPE);

        IF (vi$endpos <> 0) THEN
            POSITION (vi$endpos);

            IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) AND
                        (NOT do_back) AND
                        (INDEX (vi$weird_moves, ASCII (nchar)) = 0) THEN
                MOVE_HORIZONTAL (-1);
            ENDIF;

            era_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);

            IF (era_range <> 0) THEN
                IF (GET_INFO (dest_buf, "TYPE") = INTEGER) THEN
                    vi$cur_text := vi$put2del_buf (vi$yank_mode, era_range);
                ELSE
                    vi$type2buf (STR (vi$yank_mode), dest_buf);
                    vi$cur_text := vi$cp2buf (era_range, dest_buf);
                ENDIF;

                vi$undo_end := 0;
                vi$undo_start := vi$start_pos;
                POSITION (BEGINNING_OF (era_range));
                vi$save_for_undo (era_range, vi$yank_mode, 1);
                ERASE (era_range);
            ELSE
                vi$message ("Internal error while deleting!");
            ENDIF;
            POSITION (vi$start_pos);
        ELSE
            vi$abort (0);
            POSITION (opos);
        ENDIF;
    ELSE
        POSITION (opos);
        vi$abort (0);
    ENDIF;

    vi$check_length (olen);
ENDPROCEDURE;

!
!   This procedure checks a change in the size of the buffer, and reports
!   the change if it is greater than the number set with ":set report"
!
PROCEDURE vi$check_length (olen)
    LOCAL
        nlen;

    nlen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");

    IF (nlen - vi$report) >= olen THEN
        vi$message (STR (nlen - olen) + " more lines!");
    ELSE
        IF (nlen + vi$report <= olen) THEN
            vi$message (STR (olen - nlen) + " fewer lines!");
        ENDIF;
    ENDIF;
ENDPROCEDURE;

!
!   Perform the yank command tied to the 'y' key.
!
PROCEDURE vi$_yank (opchar, dest_buf)

    LOCAL
        old_offset,
        new_offset,
        pos,
        oline,
        nline,
        yank_range,
        prog,
        do_back,
        nchar;

    ON_ERROR;
        vi$message ("Error occured during yank, at line: "+STR(ERROR_LINE));
        POSITION (vi$start_pos);
        RETURN;
    ENDON_ERROR;

    nchar := opchar;
    pos := MARK (NONE);

    IF nchar = 0 THEN
        nchar := vi$init_action (oline);
    ENDIF;

    old_offset := -1;
    new_offset := -1;

    ! If the movement will be backwards, then the region must not include
    ! the current character.

    do_back := vi$get_direction (nchar);

    IF do_back THEN
        old_offset := CURRENT_OFFSET;
        vi$move_horizontal (-1);
        new_offset := CURRENT_OFFSET;
    ENDIF;

    vi$start_pos := MARK (NONE);

    ! For "yl" and similar moves, we must let vi$left to the movement.

    IF (INDEX (vi$weird2_moves, ASCII(nchar)) <> 0) AND
                                                (old_offset <> new_offset) THEN
        MOVE_HORIZONTAL (1);
    ENDIF;

    prog := vi$get_prog (nchar);

    IF prog <> "" THEN
        vi$do_movement (prog, VI$YANK_TYPE);

        oline := vi$cur_line_no;
        IF (vi$endpos <> 0) THEN
            POSITION (vi$endpos);
            nline := vi$abs (vi$cur_line_no - oline);
            IF (nline >= vi$report) THEN
                vi$message (STR (nline) + " lines yanked");
            ENDIF;
            IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) AND
                        (NOT do_back) AND
                        (INDEX (vi$weird_moves, ASCII (nchar)) = 0) THEN
                MOVE_HORIZONTAL (-1);
            ENDIF;

            yank_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);

            IF (yank_range <> 0) THEN
                IF (GET_INFO (dest_buf, "TYPE") = INTEGER) THEN
                    vi$cur_text := vi$put2yank_buf (yank_range, vi$temp_buf);
                ELSE
                    vi$cur_text := vi$put2yank_buf (yank_range, dest_buf);
                ENDIF;
            ELSE
                vi$message ("Internal error while yanking!");
            ENDIF;
        ELSE
            vi$abort (0);
        ENDIF;

        POSITION (pos);
    ELSE
        vi$abort (0);
    ENDIF;

ENDPROCEDURE;

!
!   Return the absolute value of the value passed.
!
PROCEDURE vi$abs (val)
    IF val < 0 THEN
        RETURN (-val);
    ENDIF;
    RETURN (val);
ENDPROCEDURE;

!
!   Given a range of a buffer, or a string, place it into the "kill-ring"
!   sliding the text back one slot that is already there.
!
PROCEDURE vi$put2del_buf (mode, string_parm)

    LOCAL
        local_str,
        pos;

    pos := MARK (NONE);

    IF (mode = VI$LINE_MODE) THEN

        ! Slide each range back one slot, throwing away the last.

        vi$mv2buf (vi$del_buf_8, vi$del_buf_9);
        vi$mv2buf (vi$del_buf_7, vi$del_buf_8);
        vi$mv2buf (vi$del_buf_6, vi$del_buf_7);
        vi$mv2buf (vi$del_buf_5, vi$del_buf_6);
        vi$mv2buf (vi$del_buf_4, vi$del_buf_5);
        vi$mv2buf (vi$del_buf_3, vi$del_buf_4);
        vi$mv2buf (vi$del_buf_2, vi$del_buf_3);
        vi$mv2buf (vi$del_buf_1, vi$del_buf_2);

        ! Place the new text at the front.

        vi$type2buf (STR(mode), vi$del_buf_1);
        vi$cp2buf (string_parm, vi$del_buf_1);
    ENDIF;

    ! Save the text so that a normal 'p' or 'P' command also works.

    vi$type2buf (STR(mode), vi$temp_buf);
    vi$cp2buf (string_parm, vi$temp_buf);

    POSITION (pos);
    RETURN (vi$temp_buf);
ENDPROCEDURE;

!
!   Copy the text specified by source into the delete buffer given by
!   dest.  If dest is zero, the it will be set to the value of a newly
!   created buffer.
!
PROCEDURE vi$cp2buf (source, dest)
    LOCAL
        pos;

    pos := MARK (NONE);

    IF (source <> 0) THEN
        IF (dest = 0) THEN
            dest := vi$init_buffer ("TEMP_BUF_"+str(vi$temp_buf_num), "");
            vi$temp_buf_num := vi$temp_buf_num + 1;
        ENDIF;

        POSITION (dest);
        COPY_TEXT (source);
    ENDIF;

    POSITION (pos);
ENDPROCEDURE;

!
!   vi$mv2buf is like vi$cp2buf except that vi$mv2buf erases the buffer before
!   performing the copy.
!
PROCEDURE vi$mv2buf (source, dest)
    LOCAL
        pos;

    pos := MARK (NONE);

    IF (source <> 0) THEN
        IF (dest = 0) THEN
            dest := vi$init_buffer ("TEMP_BUF_"+str(vi$temp_buf_num), "");
            vi$temp_buf_num := vi$temp_buf_num + 1;
        ELSE
            ERASE (dest);
        ENDIF;

        POSITION (dest);
        COPY_TEXT (source);
    ENDIF;

    POSITION (pos);
ENDPROCEDURE;

!
!   Given the string representation of either VI$LINE_MODE or VI$IN_LINE_MODE,
!   place that text into the buffer given by dest.
!
PROCEDURE vi$type2buf (source, dest)
    LOCAL
        pos;

    pos := MARK (NONE);

    IF (source <> 0) THEN
        IF (dest = 0) THEN
            dest := vi$init_buffer ("TEMP_BUF_"+str(vi$temp_buf_num), "");
            vi$temp_buf_num := vi$temp_buf_num + 1;
        ELSE
            ERASE (dest);
        ENDIF;

        POSITION (BEGINNING_OF (dest));
        COPY_TEXT (source);
        SPLIT_LINE;
    ENDIF;

    POSITION (pos);
ENDPROCEDURE;

!
!   Save a piece of yanked text including the mode that it was yanked.
!
PROCEDURE vi$put2yank_buf (string_parm, dest_buf)

    LOCAL
        pos;

    pos := MARK (NONE);

    ! Set type of text in buffer.

    vi$type2buf (STR (vi$yank_mode), dest_buf);
    vi$cp2buf (string_parm, dest_buf);
    POSITION (pos);

    RETURN (dest_buf);
ENDPROCEDURE;

!
!   This is a debugging procedure used to view the contents of a buffer.
!   It displays the buffer indicated by 'buf', and sets the status line
!   of the window displayed to contain the text given by 'stat_line'.
!
PROCEDURE vi$show_buf (buf, stat_line)
    LOCAL
        this_key,
        pos,
        new_win;

    IF (GET_INFO (buf, "TYPE") <> BUFFER) THEN
        vi$message ("show_buf called with non_buffer, message: "+stat_line);
        RETURN;
    ENDIF;

    pos := MARK (NONE);
    new_win := CREATE_WINDOW (1, 23, ON);
    MAP (new_win, buf);
    POSITION (buf);
    SET (STATUS_LINE, new_win, REVERSE, stat_line +
                ", BUFFER NAME: '"+GET_INFO (buf, "NAME")+"'");
    vi$pos_in_middle (MARK (NONE));
    UPDATE (new_win);
    LOOP
        vi$message ("Press RETURN to continue editing...");
        this_key := READ_KEY;
        EXITIF (this_key = RET_KEY);

        IF (this_key = CTRL_D_KEY) OR
           (this_key = CTRL_U_KEY) OR
           (this_key = CTRL_F_KEY) OR
           (this_key = CTRL_B_KEY) OR
           (this_key = KEY_NAME ('h')) OR
           (this_key = KEY_NAME ('j')) OR
           (this_key = KEY_NAME ('k')) OR
           (this_key = KEY_NAME ('l')) THEN

            EXECUTE (LOOKUP_KEY (this_key, PROGRAM, vi$cmd_keys));
            UPDATE (new_win);
        ENDIF;
    ENDLOOP;

    UNMAP (new_win);
    DELETE (new_win);
    POSITION (pos);
    UPDATE (CURRENT_WINDOW);
ENDPROCEDURE;

!
!   This procedure moves the cursor down the number of lines indicated by
!   vi$active count.  The parameter passed is used by delete and yank
!   operations to differentiate them from normal cursor movement.
!
PROCEDURE vi$downline (adj)

    LOCAL
        pos,
        tabstops,
        cur_off,
        offset;

    !  Ignore error messages

    ON_ERROR
        vi$active_count := 0;
        POSITION (pos);
        RETURN (0);
    ENDON_ERROR;

    pos := MARK (NONE);

    MOVE_HORIZONTAL (-CURRENT_OFFSET);
    vi$start_pos := MARK (NONE);

    POSITION (pos);

    tabstops := GET_INFO (CURRENT_BUFFER, "TAB_STOPS");

    IF (GET_INFO (tabstops, "TYPE") <> STRING) THEN
        offset := CURRENT_OFFSET;
        cur_off := GET_INFO (SCREEN, "CURRENT_COLUMN") - 1;
        MOVE_VERTICAL (vi$cur_active_count + adj);
        MOVE_HORIZONTAL (-CURRENT_OFFSET);
        IF (vi$new_offset = 1) THEN
            vi$max_offset := cur_off;
            vi$new_offset := 0;
        ELSE
            IF (cur_off < vi$max_offset) THEN
                cur_off := vi$max_offset;
            ENDIF;
        ENDIF;

        !  Save the beginning of the line as the new beginning.

        vi$new_endpos := MARK (NONE);
        vi$to_offset (CURRENT_LINE, cur_off, tabstops);
    ELSE
        MOVE_VERTICAL (vi$cur_active_count + adj);
    ENDIF;

    vi$yank_mode := VI$LINE_MODE;
    RETURN (vi$retpos (pos));
ENDPROCEDURE;

!
! Move left one location.  Do not wrap at edge of the screen.
!
PROCEDURE vi$left

    LOCAL
        pos;

    !  Ignore error messages

    ON_ERROR
        vi$active_count := 0;
        POSITION (pos);
        RETURN (0);
    ENDON_ERROR;

    pos := MARK (NONE);

    vi$new_offset := 1;
    IF (CURRENT_OFFSET < vi$active_count) OR (CURRENT_OFFSET = 0) THEN
        vi$active_count := 0;
        RETURN (0);
    ENDIF;

    MOVE_HORIZONTAL (-vi$cur_active_count);
    vi$yank_mode := VI$IN_LINE_MODE;
    RETURN (vi$retpos (pos));
ENDPROCEDURE;

!
! Move right one location.  Stop at the end of the line, but, do not
! wrap at edge of the screen.
!
PROCEDURE vi$right

    LOCAL
        pos,
        line,
        offset;

    !  Ignore error messages

    ON_ERROR
        vi$active_count := 0;
        POSITION (pos);
        RETURN (0);
    ENDON_ERROR

    pos := MARK (NONE);

    line := CURRENT_LINE;
    offset := CURRENT_OFFSET;

    ! This makes it possible to use the "s" command at the end of the line.

    IF (vi$command_type = VI$CHANGE_TYPE) THEN
        offset := offset - 1;
        IF (LENGTH (CURRENT_LINE) = 0) THEN
            COPY_TEXT (" ");
            MOVE_HORIZONTAL (-1);
            vi$start_pos := MARK (NONE);
        ENDIF;
    ENDIF;

    IF (vi$active_count < (LENGTH (line) - offset -
                                    (vi$command_type = VI$OTHER_TYPE))) THEN
        MOVE_HORIZONTAL (vi$cur_active_count);
    ELSE
        vi$active_count := 0;
        RETURN (0);
    ENDIF;

    vi$new_offset := 1;

    vi$yank_mode := VI$IN_LINE_MODE;
    RETURN (vi$retpos (pos));
ENDPROCEDURE;

!
! Move up one row, staying in the same column.  Scroll if necessary.
!
PROCEDURE vi$upline

    LOCAL
        pos,
        tabstops,
        offset,
        cur_off;

    !  Ignore error messages

    ON_ERROR
        vi$active_count := 0;
        POSITION (pos);
        RETURN (0);
    ENDON_ERROR;

    pos := MARK (NONE);

    tabstops := GET_INFO (CURRENT_BUFFER, "TAB_STOPS");

    MOVE_HORIZONTAL (-CURRENT_OFFSET);
    MOVE_HORIZONTAL (LENGTH(vi$current_line) + 1);
    vi$new_endpos := MARK(NONE);

    POSITION (pos);

    ! We must understand it (i.e. it must be an integer) inorder to process
    ! the tabs properly.

    IF (GET_INFO (tabstops, "TYPE") <> STRING) THEN
        offset := CURRENT_OFFSET;

        cur_off := GET_INFO (SCREEN, "CURRENT_COLUMN") - 1;
        MOVE_VERTICAL(-vi$cur_active_count);
        MOVE_HORIZONTAL (-CURRENT_OFFSET);

        IF vi$new_offset = 1 THEN
            vi$max_offset := cur_off;
            vi$new_offset := 0;
        ENDIF;

        IF (cur_off < vi$max_offset) THEN
            cur_off := vi$max_offset;
        ENDIF;

        !  Save the beginning of the line as the new beginning.

        vi$start_pos := MARK (NONE);
        vi$to_offset (CURRENT_LINE, cur_off, tabstops);
    ELSE
        MOVE_VERTICAL (-vi$cur_active_count);
    ENDIF;
    vi$yank_mode := VI$LINE_MODE;
    RETURN (vi$retpos (pos));
ENDPROCEDURE;

!
!   Move the cursor to the offset given by 'offset' counting tabs as expanded
!   spaces.
!
PROCEDURE vi$to_offset (line, offset, tabstops)
    LOCAL
        cur_ch,
        col,
        diff,
        len,
        tab,
        idx;

    idx := 1;
    col := 0;
    len := LENGTH (line);
    tab := ASCII (9);

    LOOP
        EXITIF (len < idx) OR (col >= offset);
        IF (SUBSTR (line, idx, 1) = tab) THEN
            diff := (((col+tabstops)/tabstops)*tabstops)-col;
        ELSE
            diff := 1;
        ENDIF;
        col := col + diff;
        idx := idx + 1;
    ENDLOOP;

    !  Move N characters to the right.

    MOVE_HORIZONTAL (idx - 1);
ENDPROCEDURE;

!
!   Search for a text string.  This procedure is activated by typing
!   either a '/' or a '?'.
!
PROCEDURE vi$search (direction)
    LOCAL
        where,
        i,
        pos,
        ch,
        sstr,
        cnt,
        add_spec,
        prompt;

    pos := MARK (NONE);

    IF (direction > 0) THEN
        prompt := "/";
    ELSE
        prompt := "?";
    ENDIF;

    IF (vi$read_a_line (prompt, sstr) = 0) THEN
        RETURN (0);
    ENDIF;

    i := 1;
    LOOP
        EXITIF (i > LENGTH (sstr));
        ch := SUBSTR (sstr, i, 1);
        IF (ch = "\") THEN
            i := i + 1;
        ELSE
            EXITIF (ch = prompt);
        ENDIF;
        i := i + 1;
    ENDLOOP;

    add_spec := 0;
    IF (ch = prompt) THEN
        add_spec := SUBSTR (sstr, i+1, 255);
        sstr := SUBSTR (sstr, 1, i-1);
        MESSAGE("add_spec: "+add_spec);
        MESSAGE("sstr: "+sstr);
    ENDIF;

    IF (direction > 0) THEN
        SET (FORWARD, CURRENT_BUFFER);
        vi$last_search_dir := 1;
        MOVE_HORIZONTAL (1);
    ELSE
        SET (REVERSE, CURRENT_BUFFER);
        vi$last_search_dir := -1;
    ENDIF;

    IF sstr <> "" THEN
        vi$search_string := sstr;
    ELSE
        IF vi$search_string = 0 THEN
            vi$message ("No previous string to search for!");
            POSITION (pos);
            RETURN (0);
        ENDIF;
    ENDIF;

    ! On success then return the position we moved to.

    cnt := vi$cur_active_count;
    LOOP
        where := vi$find_str (vi$search_string, 0);
        EXITIF (where = 0);
        POSITION (BEGINNING_OF (where));
        IF (CURRENT_DIRECTION = FORWARD) THEN
            MOVE_HORIZONTAL (1);
        ELSE
            MOVE_HORIZONTAL (-1);
        ENDIF;
        cnt := cnt - 1;
        EXITIF cnt = 0;
    ENDLOOP;

    IF (where = 0) THEN
        vi$message ("String not found");
    ELSE
        IF add_spec <> 0 THEN
            POSITION (where);
            IF add_spec = "-" THEN
                add_spec := "-1";
            ELSE
                IF (SUBSTR (add_spec, 1, 1) = "+") THEN
                    IF (add_spec = "+") THEN
                        add_spec := "1";
                    ENDIF;
                ELSE
                    add_spec := SUBSTR (add_spec, 2, 255);
                ENDIF;
            ENDIF;

            i := INT (add_spec);
            MOVE_VERTICAL (i);
            vi$_bol;
            where := MARK (NONE);
        ENDIF;
        MESSAGE ("");
    ENDIF;

    POSITION (pos);
    RETURN (where);
ENDPROCEDURE;

!
!   Search for the next occurence of the previously searched for string.
!   The procedure is actived by typing an 'n' or 'N' keystroke.
!
PROCEDURE vi$search_next (direction)
    LOCAL
        prompt,
        where,
        pos,
        cnt,
        sstr;

    pos := MARK (NONE);

    IF vi$search_string = 0 THEN
        vi$message ("No previous string to search for!");
        POSITION (pos);
        RETURN (0);
    ENDIF;

    IF (direction > 0) THEN
        prompt := "/" + vi$search_string;
        SET (FORWARD, CURRENT_BUFFER);
        IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
            MOVE_HORIZONTAL (1);
        ELSE
            IF (vi$wrap_scan = 1) THEN
                POSITION (BEGINNING_OF (CURRENT_BUFFER));
            ENDIF;
        ENDIF;
    ELSE
        prompt := "?" + vi$search_string;
        SET (REVERSE, CURRENT_BUFFER);
        IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
            IF (SUBSTR (prompt, 1, 3) = "?\<") THEN
                MOVE_HORIZONTAL (-2);
            ELSE
                MOVE_HORIZONTAL (-1);
            ENDIF;
        ELSE
            IF (vi$wrap_scan = 1) THEN
                POSITION (END_OF (CURRENT_BUFFER));
            ENDIF;
        ENDIF;
    ENDIF;

    vi$message (prompt);

    ! On success then return the position we moved to.

    cnt := vi$cur_active_count;
    LOOP
        where := vi$find_str (vi$search_string, 0);
        EXITIF (where = 0);
        POSITION (BEGINNING_OF (where));
        IF (CURRENT_DIRECTION = FORWARD) THEN
            MOVE_HORIZONTAL (1);
        ELSE
            MOVE_HORIZONTAL (-1);
        ENDIF;
        cnt := cnt - 1;
        EXITIF cnt = 0;
    ENDLOOP;

    IF (where = 0) THEN
        vi$message ("String not found");
    ELSE
        vi$message ("");
    ENDIF;

    POSITION (pos);
    RETURN (where);
ENDPROCEDURE;

!
!   This procedure can be used to find a string of text (using RE's).
!   The current direction of the BUFFER is used to determine which way
!   the search goes.  'replace' is used by the replace code to indicate
!   that wrap scan should be performed.
!
PROCEDURE vi$find_str (sstr, replace)
    LOCAL
        pos,
        new_pat,
        start,
        where;

    ON_ERROR
    ENDON_ERROR;

    pos := MARK (NONE);
    IF vi$magic THEN
        new_pat := vi$re_pattern_gen (sstr);
    ELSE
        new_pat := vi$pattern_gen (sstr);
    ENDIF;

    IF (new_pat <> 0) THEN
        EXECUTE (COMPILE ("vi$_find_pat := " + new_pat));
        where := SEARCH (vi$_find_pat, CURRENT_DIRECTION, vi$ignore_case);
        IF (where = 0) AND (vi$wrap_scan = 1) AND (replace = 0) THEN
            IF (CURRENT_DIRECTION = FORWARD) THEN
                POSITION (BEGINNING_OF (CURRENT_BUFFER));
            ELSE
                POSITION (END_OF (CURRENT_BUFFER));
            ENDIF;
            where := SEARCH (vi$_find_pat, CURRENT_DIRECTION, vi$ignore_case);
        ENDIF;
    ELSE
        where := 0;
    ENDIF;

    IF (where <> 0) AND (vi$in_ws) THEN
        POSITION (BEGINNING_OF (where));
        IF (CURRENT_OFFSET <> 0) OR
                                (INDEX (vi$_ws, CURRENT_CHARACTER) <> 0) THEN
            MOVE_HORIZONTAL (1);
        ENDIF;
        start := MARK (NONE);
        POSITION (END_OF (where));
        IF (CURRENT_OFFSET <> LENGTH (CURRENT_LINE)) THEN
            MOVE_HORIZONTAL (-1);
        ENDIF;
        where := CREATE_RANGE (start, MARK (NONE), NONE);
        POSITION (pos);
    ENDIF;
    RETURN (where);
ENDPROCEDURE;

!
!   Generate a TPU pattern string, not using RE's, i.e. :set nomagic is
!   in effect when this routine is used.
!
PROCEDURE vi$pattern_gen (pat)

    LOCAL
        first,      ! First pattern to be done
        part_pat,
        chno,
        startchar,
        haveany,
        regular,
        tstr,
        endchar,
        str_pat,
        cur_pat,    ! The current pattern to be extracted
        cur_char,   ! The current character in the regular
                    ! expression being examined
        new_pat,    ! The output pattern
        pos;        ! The position within the regular
                    ! expression string that we are examining
                    ! currently

    IF (INDEX (pat, "$") <> 0) OR (INDEX (pat, "^") <> 0) THEN
        new_pat := "";
    ELSE
        new_pat := '"'+pat+'"';
        RETURN (new_pat);
    ENDIF;

    pos := 1;

    IF SUBSTR (pat, pos, 1) = "^" THEN
        IF LENGTH (pat > 1) THEN
            new_pat := "line_begin & '";
        ELSE
            new_pat := "line_begin";
        ENDIF;
        pos := pos + 1;
    ENDIF;

    LOOP
        EXITIF (pos > LENGTH (pat));

        regular := 0;
        cur_pat := "";
        cur_char := substr (pat, pos, 1);

        IF (cur_char = "$") AND (pos+1 >= LENGTH (pat)) THEN
            IF pos <> 1 THEN
                cur_pat := "' & line_end";
            ELSE
                cur_pat := "line_end";
NDIF;