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

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

$ WRITE SYS$OUTPUT "Creating ""VI.10"""
$ CREATE VI.10
$ DECK/DOLLARS=$$EOD$$
    IF (direction = -1) THEN
        LOOP
            EXITIF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER));
            MOVE_HORIZONTAL (-1);
            EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE);
        ENDLOOP;
    ENDIF;

    LOOP
        EXITIF ((MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) AND
                (direction = -1));
        EXITIF ((MARK (NONE) = END_OF (CURRENT_BUFFER)) AND
                (direction = 1));
        EXITIF (CURRENT_CHARACTER = "");
        EXITIF vi$get_type (CURRENT_CHARACTER) = VI$SPACE_TYPE;
        MOVE_HORIZONTAL (direction);
    ENDLOOP;

    ! A hack to make change work like it is supposed to with "cw".

    IF (vi$command_type = VI$CHANGE_TYPE) AND (direction = 1) THEN
        vi$new_endpos := MARK (NONE);
    ENDIF;

    IF (direction = 1) THEN
        LOOP
            EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
            EXITIF (CURRENT_CHARACTER = "");
            MOVE_HORIZONTAL (1);
            EXITIF vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE;
        ENDLOOP;
    ELSE
        IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
            MOVE_HORIZONTAL (1);
        ENDIF;
    ENDIF;

    RETURN (vi$retpos(pos));
ENDPROCEDURE;

!
!   Move the cursor by logical words.  Note that words in this case are
!   delimited by a change from one type of character to another.  The
!   predefined types
!
!       VI$ALPHA_TYPE, VI$PUNCT_TYPE, and VI$SPACE_TYPE
!
!   are used to detect transitions from one word to the next;
!
PROCEDURE vi$move_logical_word (direction)

    LOCAL
        this_type,
        this_char,
        pos;

    pos := MARK (NONE);

    !   If direction is back, then skip SPACE characters until no space
    !   is found.

    IF (direction = -1) THEN
        LOOP
            EXITIF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER));
            MOVE_HORIZONTAL (-1);
            EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE);
        ENDLOOP;
    ENDIF;

    this_char := CURRENT_CHARACTER;
    this_type := vi$get_type (this_char);

    LOOP
        EXITIF ((MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) AND
                (direction = -1));

        EXITIF ((MARK (NONE) = END_OF (CURRENT_BUFFER)) AND
                (direction = 1));

        MOVE_HORIZONTAL (direction);
        EXITIF (vi$get_type (CURRENT_CHARACTER) <> this_type);
    ENDLOOP;

    ! A hack to make change work like it is supposed to with "cw".

    IF (vi$command_type = VI$CHANGE_TYPE) AND (direction = 1) THEN
        vi$new_endpos := MARK (NONE);
    ENDIF;

    IF (direction = 1) THEN
        LOOP
            EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE);
            MOVE_HORIZONTAL (1);
            EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
        ENDLOOP;
    ELSE
        IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
            MOVE_HORIZONTAL (1);
        ENDIF;
    ENDIF;

    RETURN (vi$retpos (pos));

ENDPROCEDURE;

!
!   Move the cursor by BLANK separated words.  DIRECTION is either
!   +1, or -1 to indicate the direction (forward, or backword respectfully)
!   to move
!
PROCEDURE vi$move_full_end

    LOCAL
        pos;

    pos := MARK (NONE);

    MOVE_HORIZONTAL (1);
    LOOP
        EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
        EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE);
        MOVE_HORIZONTAL (1);
    ENDLOOP;

    LOOP
        EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
        EXITIF (vi$get_type (CURRENT_CHARACTER) = VI$SPACE_TYPE);
        MOVE_HORIZONTAL (1);
    ENDLOOP;

    MOVE_HORIZONTAL (-1);
    RETURN (vi$retpos(pos));
ENDPROCEDURE;

!
!   Move the cursor by logical words.  Note that words in this case are
!   delimited by a change from one type of character to another.  The
!   predefined types
!
!       VI$ALPHA_TYPE, VI$PUNCT_TYPE, and VI$SPACE_TYPE
!
!   are used to detect transitions from one word to the next;
!
PROCEDURE vi$move_logical_end

    LOCAL
        this_type,
        this_char,
        pos;

    pos := MARK (NONE);

    MOVE_HORIZONTAL (1);
    LOOP
        EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
        EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE);
        MOVE_HORIZONTAL (1);
    ENDLOOP;

    this_char := CURRENT_CHARACTER;
    this_type := vi$get_type (this_char);

    LOOP
        EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
        EXITIF (vi$get_type (CURRENT_CHARACTER) <> this_type);
        MOVE_HORIZONTAL (1);
    ENDLOOP;

    MOVE_HORIZONTAL (-1);
    RETURN (vi$retpos (pos));
ENDPROCEDURE;

!
!   Return the logical type of the character passed.  This is typically used
!   by the move_by_word routines to determine when a word ends.
!
PROCEDURE vi$get_type (this_char)

    LOCAL
        this_type;

    IF (this_char = "") THEN
        RETURN (VI$EOL_TYPE);
    ENDIF;

    this_type := VI$SPACE_TYPE;

    IF (INDEX (vi$_alpha_chars, this_char) <> 0) THEN
        this_type := VI$ALPHA_TYPE;
    ELSE
        IF (INDEX (vi$_punct_chars, this_char) <> 0) THEN
            this_type := VI$PUNCT_TYPE;
        ENDIF;
    ENDIF;

    RETURN (this_type);
ENDPROCEDURE;

!
!   This procedure determines what line the cursor is currently positioned
!   on. and then prints that information, along with other items of interest
!   in the message window.
!
PROCEDURE vi$what_line

    LOCAL
        percent,
        mod,
        outfile,
        lines,
        nowr,
        pos,
        cnt;

    ON_ERROR;
        lines := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
        IF (cnt) > lines THEN
            cnt := lines;
        ENDIF;

        IF lines = 0 THEN
            percent := 0;
        ELSE
            percent := (cnt*100)/lines;
        ENDIF;

        vi$message (FAO ("!ASLine !UL of !UL, !UL%, !AS!AS",
                                    nowr, cnt, lines, percent, mod, outfile));

        SET (TIMER, OFF);
        RETURN;
    ENDON_ERROR;

    nowr := " ";
    IF (GET_INFO (CURRENT_BUFFER, "NO_WRITE")) THEN
        nowr := "*";
    ENDIF;

    mod := "";
    IF GET_INFO (CURRENT_BUFFER, "MODIFIED") THEN
        mod := "[modified] ";
    ENDIF;

    pos := MARK(NONE);
    MOVE_HORIZONTAL (- CURRENT_OFFSET);

    cnt := 0;
    lines := 0;
    outfile := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE");
    IF (outfile = 0) THEN
        outfile := "Not Edited";
    ELSE
        outfile := """"+outfile+"""";
    ENDIF;

    cnt := vi$cur_line_no;

    POSITION (pos);

    lines := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
    IF (cnt) > lines THEN
        cnt := lines;
    ENDIF;

    IF lines = 0 THEN
        percent := 0;
    ELSE
        percent := (cnt*100)/lines;
    ENDIF;

    vi$message (FAO ("!ASLine !UL of !UL, !UL%, !AS!AS",
                                    nowr, cnt, lines, percent, mod, outfile));
    SET (TIMER, OFF);
ENDPROCEDURE;

!
!   This function moves to "pos" if it is non-zero.  If "pos" is zero, then
!   any current macro is aborted, and the current position is not changed.
!   "save_pos" is a boolean value that indicates whether or not the current
!   location is remembered so that it can be returned to later with the
!   "'" (go to marker) command.
!
PROCEDURE vi$position (pos, save_pos)
    IF (pos <> 0) THEN
        IF save_pos THEN
            vi$old_place := MARK (NONE);
        ENDIF;
        POSITION (pos);
    ELSE
        RETURN (vi$abort (0));
    ENDIF;
    RETURN (pos);
ENDPROCEDURE;

!
!   This function implements the command mode function of joining the
!   current line with the one below it.
!
!   The undo operation consists of deleting the line created by joining
!   the two lines, and then inserting the original contents of the two
!   joined lines.
!
PROCEDURE vi$_join_lines

    LOCAL
        start,
        end,
        spos,
        epos,
        pos,
        plen,
        len;

    ON_ERROR
        !  Throw away moved beyond end of buffer messages.
        RETURN;
    ENDON_ERROR;

    spos := MARK (NONE);
    MOVE_HORIZONTAL (-CURRENT_OFFSET);
    pos := MARK (NONE);
    IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
        MOVE_VERTICAL (1);
        IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
            MOVE_VERTICAL (1);
            MOVE_HORIZONTAL (-1);
            epos := MARK (NONE);
            POSITION (spos);
            vi$save_for_undo (CREATE_RANGE (pos, epos, NONE),
                                                            VI$LINE_MODE, 1);
            POSITION (pos);
        ELSE
            RETURN;
        ENDIF;
    ELSE
        RETURN;
    ENDIF;

    MOVE_HORIZONTAL (LENGTH (vi$current_line));

    LOOP
        EXITIF (CURRENT_OFFSET = 0);
        MOVE_HORIZONTAL (-1);
        EXITIF INDEX ("     ", CURRENT_CHARACTER) = 0;
        ERASE_CHARACTER (1);
    ENDLOOP;

    plen := LENGTH (vi$current_line);
    vi$_next_line;

    IF (CURRENT_OFFSET > 0) AND (plen > 0) THEN
        ERASE_CHARACTER (-CURRENT_OFFSET);
    ENDIF;

    len := LENGTH (vi$current_line);
    APPEND_LINE;

    IF (len > 0) AND (plen > 0) THEN
        COPY_TEXT (" ");
        MOVE_HORIZONTAL (-1);
    ELSE
        vi$check_rmarg;
    ENDIF;

    pos := MARK (NONE);

    MOVE_HORIZONTAL (-CURRENT_OFFSET);
    vi$undo_start := MARK (NONE);
    MOVE_HORIZONTAL (LENGTH (vi$current_line));
    vi$undo_end := MARK (NONE);

    POSITION (pos);
ENDPROCEDURE;

!
!   This function filters the selected region through the command
!   given.
!
PROCEDURE vi$region_filter

    LOCAL
        era_range,
        prog,
        nchar,
        copy_line,
        orig_pos,
        last_pos,
        pos,
        exitnow,
        olen,
        this_pos,
        cur_tabs;

    vi$message ("");

    vi$start_pos := MARK (NONE);
    pos := MARK (NONE);
    nchar := vi$init_action (olen);
    prog := vi$get_prog (nchar);

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

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

            IF (MARK (NONE) = vi$endpos) THEN
                MOVE_VERTICAL (1);
                vi$endpos := MARK (NONE);
            ENDIF;

            POSITION (vi$endpos);

            vi$move_horizontal (-1);
            era_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);
            MOVE_HORIZONTAL (1);

            IF (era_range <> 0) THEN
                vi$undo_end := 0;
                POSITION (vi$start_pos);
                vi$save_for_undo (era_range, VI$LINE_MODE, 1);

                POSITION (vi$start_pos);
                MOVE_HORIZONTAL (- CURRENT_OFFSET);

                orig_pos := vi$get_undo_start;

                IF (vi$filter_region (era_range, 0) = 0) THEN
                    vi$kill_undo;
                    vi$undo_end := 0;
                    POSITION (pos);
                    RETURN (vi$abort (0));
                ENDIF;

                IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
                    MOVE_HORIZONTAL (-1);
                ENDIF;

                vi$undo_end := MARK (NONE);

                vi$undo_start := vi$set_undo_start (orig_pos);
                vi$check_length (olen);
            ELSE
                vi$message ("Internal error while filtering!");
            ENDIF;
        ELSE
            vi$abort (0);
        ENDIF;
    ELSE
        vi$abort (0);
    ENDIF;

ENDPROCEDURE;

!
!   Filter the region of text indicated by "region", using the command
!   given in cmd_parm.
!
PROCEDURE vi$filter_region (region, cmd_parm)
    LOCAL
        cmd;

    ON_ERROR
        vi$message ("ERROR filtering text!");
        RETURN (0);
    ENDON_ERROR;

    cmd := cmd_parm;

    IF (vi$filter_buf = 0) THEN
        vi$filter_buf := vi$init_buffer ("$$filter_buffer$$", "");
        IF (vi$filter_buf = 0) THEN
            vi$message ("Can't create buffer, filter aborted!");
            RETURN (0);
        ENDIF;
    ELSE
        ERASE (vi$filter_buf);
    ENDIF;

    IF (cmd = 0) THEN
        IF (vi$read_a_line ("!", cmd) = 0) THEN
            RETURN (0);
        ENDIF;
    ENDIF;

    vi$info_success_off;
    IF (vi$filter_proc = 0) THEN
        IF cmd = "!" THEN
            cmd := vi$last_filter;
            IF (cmd = 0) THEN
                MESSAGE ("No previous command to use!");
                RETURN (0);
            ENDIF;
        ELSE
            vi$last_filter := cmd;
        ENDIF;

        vi$filter_proc := CREATE_PROCESS (vi$filter_buf, cmd);

        IF (vi$filter_proc = 0) THEN
            vi$message ("Can't create process, filter aborted!");
            RETURN (0);
        ENDIF;
    ENDIF;

    SEND (region, vi$filter_proc);
    IF vi$filter_proc <> 0 THEN
        DELETE (vi$filter_proc);
        vi$filter_proc := 0;
    ENDIF;

    vi$info_success_on;

    ERASE (region);
    COPY_TEXT (vi$filter_buf);
    RETURN (1);
ENDPROCEDURE;

!
!   Shift the selected text region one SHIFT_WIDTH to the right.
!
PROCEDURE vi$region_right
    vi$region_shift(1);
ENDPROCEDURE

!
!   Shift the selected text region one SHIFT_WIDTH to the left.
!
PROCEDURE vi$region_left
    vi$region_shift (0);
ENDPROCEDURE

!
!   This function shifts the selected region right or left based on
!   the mode passed.
!
!   Parameters:
!       mode            0 indicates a left shift, 1 indicates right.
!
PROCEDURE vi$region_shift (mode)

    LOCAL
        act_char,
        needed,
        era_range,
        prog,
        nchar,
        copy_line,
        tab_len,
        oline,
        nline,
        state,
        orig_pos,
        last_pos,
        exitnow,
        this_pos,
        cur_tabs;

    ON_ERROR;
        IF state <> 0 THEN
            IF (ERROR = TPU$_ENDOFBUF) AND (state := 2) THEN
                exitnow := 1;
            ELSE
                orig_pos := 0;
            ENDIF;
        ELSE
            vi$message ("Error occured during shift, at line: "+
                                                        STR(ERROR_LINE));
            POSITION (vi$start_pos);
            RETURN;
        ENDIF;
    ENDON_ERROR;

    vi$message ("");

    vi$start_pos := MARK (NONE);
    nchar := vi$init_action (state);
    state := 0;

    IF ((mode = 1) AND (ASCII (nchar) = '<')) OR
                                    ((mode = 0) AND (ASCII (nchar) = '>')) THEN
        RETURN;
    ENDIF;

    prog := vi$get_prog (nchar);

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

        oline := vi$cur_line_no;
        IF (vi$endpos <> 0) THEN
            POSITION (vi$endpos);
            MOVE_HORIZONTAL (-CURRENT_OFFSET);
            nline := vi$abs (vi$cur_line_no - oline);
            vi$endpos := MARK (NONE);
            POSITION (vi$start_pos);
            MOVE_HORIZONTAL (-CURRENT_OFFSET);

            IF (MARK (NONE) = vi$endpos) THEN
                MOVE_VERTICAL (1);
                vi$endpos := MARK (NONE);
            ENDIF;

            POSITION (vi$endpos);

            vi$move_horizontal (-1);
            era_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);
            MOVE_HORIZONTAL (1);

            IF (era_range <> 0) THEN
                vi$undo_end := 0;
                POSITION (vi$start_pos);
                vi$save_for_undo (era_range, vi$yank_mode, 1);

                POSITION (vi$start_pos);
                MOVE_HORIZONTAL (- CURRENT_OFFSET);

                orig_pos := vi$get_undo_start;

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

                IF (GET_INFO (cur_tabs, "TYPE") = STRING) THEN
                    vi$message ("Can't shift region with uneven tabstops.");
                    RETURN;
                ELSE
                    tab_len := cur_tabs;
                ENDIF;

                state := 2;
                exitnow := 0;

                LOOP
                    EXITIF MARK (NONE) = vi$endpos;
                    EXITIF MARK (NONE) = END_OF (CURRENT_BUFFER);
                    EXITIF (exitnow = 1);

                    copy_line := vi$current_line;

                    IF (copy_line <> "") THEN

                        ! Copy line is truncated to have no leading spaces.

                        needed := vi$vis_indent (copy_line, tab_len);

                        IF mode = 1 THEN
                            needed := needed + vi$shift_width;
                        ELSE
                            needed := needed - vi$shift_width;
                        ENDIF;

                        IF (needed < 0) THEN
                            needed := 0;
                        ENDIF;

                        ERASE_LINE;
                        COPY_TEXT (vi$get_tabs (needed, tab_len)+copy_line);

                        MOVE_HORIZONTAL (1);
                        IF (MARK (NONE) <> END_OF(CURRENT_BUFFER)) THEN
                            MOVE_HORIZONTAL (-1);
                            SPLIT_LINE;
                        ENDIF;
                    ELSE
                        MOVE_VERTICAL (1);
                    ENDIF;
                    MOVE_HORIZONTAL (- CURRENT_OFFSET);
                ENDLOOP;

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

                vi$undo_start := vi$set_undo_start (orig_pos);
                POSITION (vi$undo_start);
                IF (nline >= vi$report) THEN
                    act_char := ">";
                    IF mode = 0 THEN
                        act_char := "<";
                    ENDIF;
                    vi$message (STR (nline) + " lines " + act_char + "'d");
                ENDIF;
            ELSE
                vi$message ("Internal error while shifting!");
            ENDIF;
        ELSE
            vi$abort (0);
        ENDIF;
    ELSE
        vi$abort (0);
    ENDIF;

ENDPROCEDURE;

!
!  This procedure is called by REGION_SHIFT to calculate the number of spaces
!  occupied on the screen by the leading white space of "line".  "tabstops"
!  holds the number of spaces a tab displays as obtained with a call to
!  GET_INFO (CURRENT_BUFFER, "TAB_STOPS").  Line is stripped of the leading
!  space on return, and the function returns the number of spaces occupied
!  on the screen.
!
PROCEDURE vi$vis_indent (line, tabstops)
    LOCAL
        idx,
        cur_ch,
        cnt;

    idx := 1;
    cnt := 0;

    LOOP
        cur_ch := SUBSTR (line, idx, 1);
        EXITIF (INDEX ("    ", cur_ch) = 0);

        IF (cur_ch = " ") THEN
            cnt := cnt + 1;
        ELSE
            cnt := cnt + (tabstops - (cnt - ((cnt / tabstops) * tabstops)));
        ENDIF;

        idx := idx + 1;
    ENDLOOP;

    ! Truncate the line removing the leading whitespace.

    line := SUBSTR (line, idx, LENGTH (line) - idx + 1);
    RETURN (cnt);
ENDPROCEDURE;

!
!  This procedure builds a string with as many tabs as possible to create
!  the indentation level given by "len".  "tabstops" is the number of spaces
!  a tab produces on the screen.
!
PROCEDURE vi$get_tabs (len, tabstops)
    LOCAL
        tab_text,
        rstr;

    rstr := "";

    ! Select the proper tabbing text based on the setting of vi$use_tabs

    tab_text := "   ";
    IF (vi$use_tabs = 0) THEN
        tab_text := SUBSTR (vi$spaces, 1, tabstops);
    ENDIF;

    LOOP
        EXITIF (len = 0);
        IF (len >= tabstops) THEN
            len := len - tabstops;
            rstr := rstr + tab_text;
        ELSE
            rstr := rstr + SUBSTR (vi$spaces, 1, len);
            len := 0;
        ENDIF;
    ENDLOOP;

    RETURN (rstr);
ENDPROCEDURE;

!
!   This function should be used to abort the current keyboard stream.
!   It will assure that a macro does not continue to operate after a
!   failure.
!
PROCEDURE vi$abort (n)
    vi$key_buf := 0;
    RETURN (n);
ENDPROCEDURE;

!
!   Decide what the current line number is.
!
PROCEDURE vi$cur_line_no
    LOCAL
        pos,
        cnt,
        val,
        opos;

    ON_ERROR
        POSITION (pos);
        IF (val > 1) THEN
            val := val / 2;
            cnt := cnt - val;
        ELSE
            POSITION (opos);
            RETURN (cnt);
        ENDIF;
    ENDON_ERROR;

    opos := MARK (NONE);
    val := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT") * 4 / 5;
    IF (val = 0) THEN
        val := 1;
    ENDIF;
    cnt := 1;
    LOOP
        pos := MARK (NONE);
        MOVE_VERTICAL (-val);
        cnt := cnt + val;
    ENDLOOP;
ENDPROCEDURE;

!
!   Copy a buffer of keys for use later.  This routine is used mostly to
!   make a copy of the last series of keystrokes from repeating when '.'
!   is typed.
!
PROCEDURE vi$copy_keys (to_keys, from_keys)
    LOCAL
        pos;

    pos := MARK (NONE);
    ERASE (to_keys);
    POSITION (to_keys);
    COPY_TEXT (from_keys);
    POSITION (BEGINNING_OF (to_keys));
    POSITION (pos);
ENDPROCEDURE;

!
!   Convert a string of characters into a buffer of key strokes.
!
PROCEDURE vi$str_to_keybuf (tstring, tbuf)
    LOCAL
        pos,
        idx;

    idx := 1;
    pos := MARK (NONE);
    POSITION (BEGINNING_OF (tbuf));

    ! Note that a bug in TPU causes ill behavior if you try to ERASE
    ! a buffer that TPU has never written anything into.

    SPLIT_LINE;
    APPEND_LINE;
    ERASE (tbuf);

    LOOP
        EXITIF idx > LENGTH (tstring);
        COPY_TEXT (STR (KEY_NAME (SUBSTR (tstring, idx, 1))));
        MOVE_HORIZONTAL (1);
        idx := idx + 1;
    ENDLOOP;

    !  There must be 2 lines (the first should be blank) at the end of the
    !  buffer to make it appear exactly as a key mapping.

    SPLIT_LINE;
    SPLIT_LINE;

    POSITION (pos);
ENDPROCEDURE;

!
!   Save the key passed into the push back buffer.
!
PROCEDURE vi$push_a_key (ch)
    LOCAL
        pos;

    pos := MARK (NONE);
    POSITION (vi$cur_keys);
    COPY_TEXT (STR (ch));
    MOVE_HORIZONTAL (1);
    POSITION (pos);
ENDPROCEDURE;

!
!   Insert the buffer passed into the stream of key_board characters so
!   that they act as a macro.
!
PROCEDURE vi$insert_macro_keys (key_buf)
    LOCAL
        spos,
        pos;

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

    pos := MARK (NONE);

    IF (vi$key_buf <> 0) THEN
        IF (vi$key_buf = vi$push_key_buf) THEN
            POSITION (vi$push_key_buf);
            MOVE_HORIZONTAL (-1);
            spos := MARK (NONE);
            MOVE_HORIZONTAL (1);
            SET (INSERT, CURRENT_BUFFER);
            COPY_TEXT (key_buf);

            !  Remove blank line at end, and possible DEFINE_KEY mapping.

            MOVE_VERTICAL (-1);
            ERASE_LINE;
            MOVE_VERTICAL (-1);
            ERASE_LINE;

            POSITION (spos);
            MOVE_HORIZONTAL (1);
        ELSE
            POSITION (vi$key_buf);
            spos := MARK (NONE);
            ERASE (vi$push_key_buf);
            POSITION (vi$push_key_buf);
            SET (INSERT, CURRENT_BUFFER);
            COPY_TEXT (CREATE_RANGE (spos, END_OF (vi$key_buf), NONE));

            !  Remove blank line at end, and possible DEFINE_KEY mapping.

            MOVE_VERTICAL (-1);
            ERASE_LINE;
            MOVE_VERTICAL (-1);
            ERASE_LINE;

            COPY_TEXT (key_buf);
            POSITION (BEGINNING_OF (vi$push_key_buf));
            vi$key_buf := vi$push_key_buf;
        ENDIF;
    ELSE
        ERASE (vi$push_key_buf);
        POSITION (vi$push_key_buf);
        SET (INSERT, CURRENT_BUFFER);
        COPY_TEXT (key_buf);
        vi$key_buf := vi$push_key_buf;
        POSITION (BEGINNING_OF (vi$push_key_buf));
    ENDIF;

    POSITION (pos);
ENDPROCEDURE;

!
!   Erase a the last key pushed back.
!
PROCEDURE vi$del_a_key
    LOCAL
        pos;

    pos := MARK (NONE);
    POSITION (vi$cur_keys);
    IF MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER) THEN
        MOVE_VERTICAL (-1);
        ERASE_LINE;
    ENDIF;
    POSITION (pos);

ENDPROCEDURE;

!
!   Read a single keystroke from either the keyboard, or from the push
!   back buffer if it is non-zero.
!
PROCEDURE vi$read_a_key

    LOCAL
        read_a_key,
        pos,
        ch;

    read_a_key := 0;

    ! If there are no keys pushed, then read the keyboard.

    IF (vi$key_buf = 0) OR (GET_INFO (vi$key_buf, "TYPE") <> BUFFER) THEN
        read_a_key := 1;
        vi$m_level := 0;
        IF vi$term_vt200 THEN
            ch := READ_KEY;
        ELSE
            ch := READ_CHAR;
        ENDIF;
    ELSE

        ! Otherwise extract the next key from the buffer.

        pos := MARK (NONE);
        POSITION (vi$key_buf);

        ! Get the key code.

        ch := INT (vi$current_line);
        MOVE_VERTICAL (1);

        ! Check for the end of the buffer.

        IF (LENGTH (vi$current_line) = 0) THEN
            vi$key_buf := 0;
        ENDIF;

        POSITION (pos);
    ENDIF;

    ! If we are not running on a VT200, then do some key translations

    IF NOT vi$term_vt200 THEN
        IF ch = ASCII(27) THEN
            ch := F11;
        ELSE
            ch := KEY_NAME (ch);
        ENDIF;
    ENDIF;

    ! If a key was read from the keyboard, then push it back.

    IF read_a_key THEN
        vi$push_a_key (ch);
    ENDIF;

    ! Save the last key read.

    vi$last_key := ch;

    ! Return the keycode of the character

    RETURN (ch);
ENDPROCEDURE;

!
!   Turn pasthru on, on the terminal
!
PROCEDURE vi$pasthru_on
    LOCAL
        junk;
    junk := CALL_USER (vi$cu_pasthru_on, "");
ENDPROCEDURE;

!
!   Turn pasthru off, on the terminal
!
PROCEDURE vi$pasthru_off
    LOCAL
        junk;
    junk := CALL_USER (vi$cu_pasthru_off, "");
ENDPROCEDURE;

!
!   Spawn with pasthru off
!
PROCEDURE vi$spawn (cmd)
    LOCAL
        junk;

    vi$pasthru_off;
    IF (cmd = 0) THEN
        SPAWN;
    ELSE
        SPAWN (cmd);
    ENDIF;
    vi$pasthru_on;
ENDPROCEDURE

!
!   Quit with pasthru off
!
PROCEDURE vi$quit
    vi$pasthru_off;
    QUIT;
    vi$pasthru_on;
ENDPROCEDURE

!
!   Perform read_line with pasthru off
!
PROCEDURE vi$read_line (prompt)
    LOCAL
        junk;

    vi$pasthru_off;
    junk := READ_LINE (prompt);
    vi$pasthru_on;
    RETURN (junk);
ENDPROCEDURE;

!
!   Initialize things by creating buffers and windows and perform other
!   assorted operations.
!
PROCEDURE tpu$init_procedure

    LOCAL
        journal_file,
        default_journal_name,
        aux_journal_name,
        cnt,
        input_file;

    !   Flag to indicate status of editor during startup.

    vi$starting_up := 1;

    vi$info_success_off;
    SET (MESSAGE_FLAGS, 1);
    SET (BELL, BROADCAST, ON);

    !   Set the variables to their initial values.

    vi$init_vars;

    !   Remove the definition of vi$init_vars to save memory.

    COMPILE ("procedure vi$init_vars; endprocedure;");

    !   Get some other information.

    vi$term_vt200 := GET_INFO (SCREEN, "vt200");
    vi$scr_width := GET_INFO (SCREEN, "WIDTH");
    vi$scr_length := GET_INFO (SCREEN, "VISIBLE_LENGTH");

    !   Create the message buffer and window.

    message_buffer := vi$init_buffer ("Messages", "");
    message_window := CREATE_WINDOW (vi$scr_length - 1, 2, ON);
    MAP (message_window, message_buffer);
    SET (STATUS_LINE, message_window, NONE, "");
    SET (MAX_LINES, message_buffer, 500);
    ADJUST_WINDOW (message_window, 1, 0);
    vi$mess_select (REVERSE);

    !   Command prompt area.

    command_buffer := vi$init_buffer ("Commands", "");
    command_window := CREATE_WINDOW (vi$scr_length, 1, OFF);

    !   Buffer for SHOW (xxx) stuff.

    show_buffer := vi$init_buffer ("Show", "");
    info_window := CREATE_WINDOW (1, vi$scr_length - 1, ON);
    SET (STATUS_LINE, info_window, NONE, "");

    !   A buffer for the tags file(s).

    vi$tag_buf := vi$init_buffer ("Tags buffer", "");
    vi$load_tags;
    vi$dcl_buf := vi$init_buffer ("DCL buffer", "[End of DCL buffer]");
    vi$info_success_off;

    !   A buffer and a window to start editing in.

    main_buffer := CREATE_BUFFER ("Main");
    main_window := CREATE_WINDOW (1, vi$scr_length - 1, ON);
    SET (EOB_TEXT, main_buffer, "[EOB]");
    SET (STATUS_LINE, main_window, NONE, "");

    !   A buffer for wild carding and such.

    choice_buffer := vi$init_buffer ("Choices", "");

    !   A buffer for the list of files we are currently editing.

    vi$file_names := vi$init_buffer ("file_names", "");

    !   Buffer to hold last text inserted into a buffer.

    vi$last_insert := vi$init_buffer ("$$last_insert$$", "");

    !   Buffer to hold KEY_NAME values of last key sequence.

    vi$cur_keys := vi$init_buffer ("$$current_keys$$", "");

    !   Buffer to hold keys to be performed when '.' is pressed.

    vi$last_keys := vi$init_buffer ("$$last_keys$$", "");

    !   Get a buffer to hold yank and deletes that are not aimed a named
    !   buffer.

    vi$temp_buf := vi$init_buffer ("$$temp_buffer$$", "");

    !   Set up some more stuff.

    SET (PROMPT_AREA, vi$scr_length, 1, BOLD);
    SET (JOURNALING, 7);
    SET (FACILITY_NAME, "VI");

    !   Move to the initial buffer.

    MAP (main_window, main_buffer);
    POSITION (main_buffer);

    !   Get the filename to edit.

    input_file := GET_INFO (COMMAND_LINE, "FILE_NAME");

    !   If there is an input file, then get it for editing.

    IF input_file <> "" THEN
        cnt := vi$get_file (input_file);
    ENDIF;

    ! Delete the unused main buffer if it is not used.

    IF (CURRENT_BUFFER <> main_buffer) THEN
        DELETE (main_buffer);
    ENDIF;

    ! Start journaling if requested.

    IF (GET_INFO (COMMAND_LINE, "JOURNAL") = 1) THEN
        aux_journal_name := GET_INFO (CURRENT_BUFFER, "FILE_NAME");

        IF aux_journal_name = "" THEN
            aux_journal_name := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE");
        ENDIF;

        IF aux_journal_name = 0 THEN
            aux_journal_name := "";
        ENDIF;

        IF aux_journal_name = "" THEN
            default_journal_name := "MAIN.TJL";
        ELSE
            default_journal_name := ".TJL";
        ENDIF;

        journal_file := GET_INFO (COMMAND_LINE, "JOURNAL_FILE");
        journal_file := FILE_PARSE (journal_file, default_journal_name,
                                                    aux_journal_name);
        JOURNAL_OPEN (journal_file);
    ENDIF;

    ! Force undefined keystrokes ("all of them") to call vi$command_mode.

    SET (UNDEFINED_KEY, "tpu$key_map_list",
                                    COMPILE ("vi$command_mode (LAST_KEY)"));
    SET (SELF_INSERT, "tpu$key_map_list", OFF);

    vi$info_success_on;

    ! Change PF1 so that it is NOT a shift key.

    SET (SHIFT_KEY, KEY_NAME (PF1, SHIFT_KEY));

    ! Do any user added local initialization.

    tpu$local_init;

    ! Do the INI file.

    IF FILE_SEARCH ("EXRC") = "" THEN
        vi$do_file ("SYS$LOGIN:VI.INI", 0);
    ELSE
        vi$do_file ("EXRC", 0);
    ENDIF;

    vi$do_exinit;

    ! Enable passthru on the terminal so that ^Y does 'Push screen'.

    vi$pasthru_on;

    ! Say we are no longer starting up.

    vi$starting_up := 0;
ENDPROCEDURE;

!
!   Process the EXINIT environment variable (Process Logical actually).
!
PROCEDURE vi$do_exinit
    LOCAL
        exinit;

    ON_ERROR
        RETURN;
    ENDON_ERROR;

    exinit := call_user (vi$cu_trnlnm_job, "EXINIT");
    vi$do_cmd_line (exinit);
ENDPROCEDURE;

!
!   Load the file given in fn, into a buffer and execute the contents as
!   a series of EX mode commands.  "complain" is boolean, and determines
!   whether or not we complain about a non existant file.
!
PROCEDURE vi$do_file (rfn, complain)
    LOCAL
        fn,
        ini_buffer,
        ini_file;

    MESSAGE ("");
    fn := rfn;
    ini_file := FILE_SEARCH ("");
    fn := FILE_PARSE (fn);
    ini_file := FILE_SEARCH (fn);
    IF (ini_file = "") THEN
        IF (complain) THEN
            vi$message ("Can't find file """+fn+"""!");
        ENDIF;
        RETURN (1);
    ENDIF;

    vi$info_success_off;

    ini_buffer := CREATE_BUFFER ("VI$CMD$INI$$", ini_file);

    IF ini_buffer = 0 THEN
        IF (complain) THEN
            vi$message ("can't process file """+ini_file+"""!");
        ENDIF;
        vi$info_success_on;
        RETURN(1);
    ENDIF;

    vi$process_buffer (ini_buffer);
    DELETE (ini_buffer);

    vi$info_success_on;
    RETURN (1);
ENDPROCEDURE;

!
!  Execute the contents of the passed buffer as EX mode commands
!
PROCEDURE vi$process_buffer (buffer_parm)

    LOCAL
        line,
        old_pos,
        cur_pos;

    old_pos := MARK (NONE);
    POSITION (BEGINNING_OF (buffer_parm));

    LOOP
        cur_pos := MARK (NONE);
        EXITIF (cur_pos = END_OF (buffer_parm));
        line := CURRENT_LINE;

        IF (LENGTH (line) > 0) AND (SUBSTR (line, 1, 1) <> '!') THEN
            POSITION (old_pos);

            vi$do_cmd_line (line);

            old_pos := MARK (NONE);
            POSITION (cur_pos);
        ENDIF;

        MOVE_VERTICAL (1);
    ENDLOOP;

    POSITION (old_pos);
ENDPROCEDURE;

!
!
!
PROCEDURE vi$init_buffer (new_buffer_name, new_eob_text)

    LOCAL
        new_buffer;         ! New buffer

    new_buffer := CREATE_BUFFER (new_buffer_name);
    SET (EOB_TEXT, new_buffer, new_eob_text);
    SET (NO_WRITE, new_buffer);
    SET (SYSTEM, new_buffer);
    RETURN (new_buffer);

ENDPROCEDURE;

!
!   Expand the list of filenames given in "get_file_list" and return
!   the count of names found as the function value.  One possible
!   match will be returned in one_name so that if only one file matches,
!   one_name will contain that file.
!
PROCEDURE vi$expand_file_list (get_file_list)

    LOCAL
        num_names,
        fres,
        one_name,
        fn,
        fl,
        comma_pos,
        pos;

    fl := get_file_list;

    ERASE (choice_buffer);

    IF (vi$file_names = 0) THEN
        vi$file_names := vi$init_buffer ("file_names", "");
    ELSE
        ERASE (vi$file_names);
    ENDIF;

    LOOP
        ! Protect against earlier file_search.

        fres := FILE_SEARCH ("");

        EXITIF fl = "";
        comma_pos := INDEX (fl, ",");

        IF (comma_pos > 0) THEN
            fn := SUBSTR (fl, 1, comma_pos - 1);
            fl := SUBSTR (fl, comma_pos + 1, LENGTH (fl) - comma_pos);
        ELSE
            fn := fl;
            fl := "";
        ENDIF;

        LOOP
            fres := FILE_SEARCH (fn);
            EXITIF fres = "";
            vi$add_choice (fres);
            one_name := fres;
        ENDLOOP;

    ENDLOOP;

    pos := MARK (NONE);

    POSITION (vi$file_names);
    COPY_TEXT (choice_buffer);
    POSITION (BEGINNING_OF (vi$file_names));

    POSITION (pos);

    num_names := GET_INFO (choice_buffer, "RECORD_COUNT");

    RETURN (num_names);
ENDPROCEDURE;
!
! Put a file in the current window.  If the file is already in a buffer,
! use the old buffer.  If not, create a new buffer.
!
! Parameters:
!
!   file_parameter  String containing file name - input
!
PROCEDURE vi$get_file (file_parameter)

    LOCAL
        pos,
        obuf,
        get_file_parm,
        outfile,
        filename,
        file_read,
        get_file_name,          ! Local copy of get_file_parameter
        get_file_list,          ! Possible comma separated list
        temp_buffer_name,       ! String for buffer name based on get_file_name
        file_search_result,     ! Latest string returned by file_search
        temp_file_name,         ! First file name string returned by file_searc
h
        loop_cnt,               ! Number of files left to process in loop
        file_cnt,               ! Actual number of files found with FILE_SEARCH
        loop_buffer,            ! Buffer currently being checked in loop
        new_buffer,             ! New buffer created if needed
        found_a_buffer,         ! True if buffer found with same name
        want_new_buffer;        ! True if file should go into a new buffer

    ON_ERROR
        IF ERROR = TPU$_PARSEFAIL THEN
            vi$message (FAO ("Don't understand file name: !AS", get_file_name))
;
            RETURN (0);
        ENDIF;
    ENDON_ERROR;

    obuf := CURRENT_BUFFER;
    get_file_parm := file_parameter;
    IF (get_file_parm = 0) OR (get_file_parm = "") THEN
        vi$message ("File name must be supplied!");
        RETURN (0);
    ENDIF;

    get_file_list := get_file_parm;
    get_file_name := get_file_parm;
    temp_file_name := 0;

    loop_cnt := vi$expand_file_list (get_file_list);

    !   If none were found, then set up to enter the loop and get a new buffer

    IF (loop_cnt = 0) THEN
        loop_cnt := 1;
        POSITION (BEGINNING_OF (choice_buffer));
    ELSE
        IF loop_cnt > 1 THEN
            vi$message (FAO ("!UL files to edit!", loop_cnt));
        ENDIF;
        POSITION (BEGINNING_OF (choice_buffer));
        temp_file_name := vi$current_line;
        ERASE_LINE;
    ENDIF;

$$EOD$$