Usenet 1994 October/usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso/misc/volume4/vms-vi-2/part15

Internet Message Format | 1989-02-03 | 39.6 KB

Path: xanth!mcnc!gatech!cwjcc!hal!ncoast!allbery
From: [e-mail] (Gregg Wonderly)
Newsgroups: comp.sources.misc
Subject: v04i106: TPUVI for VMS part 15 of 17
Message-ID: <[e-mail]>
Date: 27 Sep 88 22:19:22 GMT
Sender: [e-mail]
Reply-To: [e-mail] (Gregg Wonderly)
Lines: 1504
Approved: [e-mail]

Posting-number: Volume 4, Issue 106
Submitted-by: "Gregg Wonderly" <[e-mail]>
Archive-name: vms-vi-2/Part15

$ WRITE SYS$OUTPUT "Creating ""VI.11"""
$ CREATE VI.11
$ DECK/DOLLARS=$$EOD$$
        copy_line,
        orig_pos,
        last_pos,
        pos,
        exitnow,
        olen,
        this_pos,
        cur_tabs;

    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);
            POSITION (LINE_BEGIN);
            vi$endpos := MARK (NONE);
            POSITION (vi$start_pos);
            POSITION (LINE_BEGIN);

            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);
                POSITION (LINE_BEGIN);

                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$info ("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$info ("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$info ("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
                vi$info ("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$info ("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$info ("Error occured during shift, at line: "+
                                                        STR(ERROR_LINE));
            POSITION (vi$start_pos);
            RETURN;
        ENDIF;
    ENDON_ERROR;

    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);
            POSITION (LINE_BEGIN);
            nline := vi$abs (vi$cur_line_no - oline);
            vi$endpos := MARK (NONE);
            POSITION (vi$start_pos);
            POSITION (LINE_BEGIN);

            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);
                POSITION (LINE_BEGIN);

                orig_pos := vi$get_undo_start;

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

                IF (GET_INFO (cur_tabs, "TYPE") = STRING) THEN
                    vi$info ("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;
                    POSITION (LINE_BEGIN);
                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$info (STR (nline) + " lines " + act_char + "'d");
                ENDIF;
            ELSE
                vi$info ("Internal error while shifting!");
            ENDIF;
        ELSE
            vi$abort (0);
        ENDIF;
    ELSE
        vi$abort (0);
    ENDIF;

ENDPROCEDURE;

!
!  This procedure is called 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 (cur_ch = "");
        EXITIF (INDEX (vi$_space_tab, 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 := ASCII (9);
    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") * 2 / 3;
    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 (INT (KEY_NAME (SUBSTR (tstring, idx, 1)))));

        ! Move to EOB so next COPY_TEXT will insert a new line.

        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 (INT (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;
        ENDIF;
    ENDIF;

    ch := KEY_NAME (ch);

    ! 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$readonly := 0;
    IF (GET_INFO (COMMAND_LINE, "READ_ONLY") = 1) THEN
        vi$readonly := 1;
    ENDIF;
    vi$info_success_off;
    SET (MESSAGE_FLAGS, 1);
    SET (BELL, BROADCAST, ON);

    !   Set the variables to their initial values.

    vi$init_vars;

    !   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 at named
    !   buffers.

    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 input_file = "" THEN
        IF (GET_INFO (COMMAND_LINE, "OUTPUT")) THEN
            input_file := GET_INFO (COMMAND_LINE, "OUTPUT_FILE");
        ENDIF;
    ENDIF;

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

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

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

    IF (CURRENT_BUFFER <> main_buffer) AND (main_buffer <> 0) 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;

    fn := rfn;
    ini_file := FILE_SEARCH ("");
    fn := FILE_PARSE (fn);
    ini_file := FILE_SEARCH (fn);
    IF (ini_file = "") THEN
        IF (complain) THEN
            vi$info ("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$info ("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;

!
!   Initialize a system/nowrite buffer.
!
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.  The file names will
!   be in the vi$file_names buffer, one per line.
!
PROCEDURE vi$expand_file_list (get_file_list)

    LOCAL
        num_names,
        fres,
        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;

    ! Expand the wild cards.  Note that this also eliminates non-existant
    ! files from the list of files to edit.

    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);
        ENDLOOP;
    ENDLOOP;

    ! Save current position.

    pos := MARK (NONE);

    ! Save a copy of the filenames list

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

    ! Move back to where we were.

    POSITION (pos);

    ! Save the count of file names.

    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_search
        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$info (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$info ("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$info (FAO ("!UL files to edit!", loop_cnt));
        ENDIF;
        POSITION (BEGINNING_OF (choice_buffer));
        temp_file_name := vi$current_line;
        ERASE_LINE;
    ENDIF;

    file_cnt := loop_cnt;

    LOOP
        IF (GET_INFO (obuf, "TYPE") = BUFFER) THEN
            POSITION (obuf);
        ENDIF;

        ! See if we already have a buffer by that name

        IF temp_file_name = 0 THEN
            temp_buffer_name :=
                FILE_PARSE (get_file_name, "", "", NAME) +
                FILE_PARSE (get_file_name, "", "", TYPE);
        ELSE
            temp_buffer_name :=
                FILE_PARSE (temp_file_name, "", "", NAME) +
                FILE_PARSE (temp_file_name, "", "", TYPE);
        ENDIF;

        IF get_file_parm <> 0 THEN

            !  Trim the trailing dot off.

            EDIT (get_file_parm, UPPER, COLLAPSE);

            IF (SUBSTR (get_file_parm, LENGTH(get_file_parm), 1)
                                                                <> '.') THEN
                IF (SUBSTR (temp_buffer_name,
                                LENGTH(temp_buffer_name), 1) = '.') THEN

                    temp_buffer_name :=
                        SUBSTR (temp_buffer_name, 1,
                                                LENGTH(temp_buffer_name)-1);
                ENDIF;
            ENDIF;
        ENDIF;

        loop_buffer := GET_INFO (BUFFERS, "FIRST");
        found_a_buffer := 0;

        LOOP
            EXITIF loop_buffer = 0;
            IF temp_buffer_name = GET_INFO (loop_buffer, "NAME") THEN
                found_a_buffer := 1;
                EXITIF 1;
            ENDIF;
            loop_buffer := GET_INFO (BUFFERS, "NEXT");
        ENDLOOP;

        ! If there is a buffer by that name, is it the same file?
        ! We ignore version numbers to keep our sanity

        IF found_a_buffer THEN      ! Have a buffer with the same name
            IF temp_file_name = 0 THEN  ! No file on disk
                IF get_file_name = GET_INFO (loop_buffer, "OUTPUT_FILE") THEN
                    want_new_buffer := 0;
                ELSE

                    !   If the buffer is empty, then throw it
                    !   away.

                    IF (GET_INFO (loop_buffer, "RECORD_COUNT") > 0) THEN
                        want_new_buffer := 0;
                    ELSE
                        IF (temp_file_name <> 0) and (temp_file_name <> "") THEN
                            vi$info ("Buffer empty, reading file");
                            POSITION (loop_buffer);
                            vi$info (FAO ('Reading "!AS"', temp_file_name));
                            file_read := READ_FILE (temp_file_name);

                            IF file_read <> "" THEN
                                SET (OUTPUT_FILE, loop_buffer, file_read);
                                vi$status_lines (loop_buffer);
                            ENDIF;
                        ENDIF;

                        want_new_buffer := 2;
                        POSITION (BEGINNING_OF (loop_buffer));
                        MAP (CURRENT_WINDOW, loop_buffer);
                        obuf := loop_buffer;
                    ENDIF;
                ENDIF;
            ELSE

                ! Check to see if the same file

                outfile := GET_INFO (loop_buffer, "OUTPUT_FILE");
                filename := GET_INFO (loop_buffer, "FILE_NAME");

                !  Trim version numbers off all of the names.

                IF (outfile <> 0) THEN
                    outfile := FILE_PARSE (outfile, "", "", DEVICE) +
                                FILE_PARSE (outfile, "", "", DIRECTORY) +
                                FILE_PARSE (outfile, "", "", NAME) +
                                FILE_PARSE (outfile, "", "", TYPE);
                ENDIF;

                IF (filename <> 0) THEN
                    filename := FILE_PARSE (filename, "", "", DEVICE) +
                                FILE_PARSE (filename, "", "", DIRECTORY) +
                                FILE_PARSE (filename, "", "", NAME) +
                                FILE_PARSE (filename, "", "", TYPE);
                ENDIF;

                temp_file_name := FILE_PARSE (temp_file_name, "", "", DEVICE) +
                                FILE_PARSE (temp_file_name, "", "", DIRECTORY) +
                                FILE_PARSE (temp_file_name, "", "", NAME) +
                                FILE_PARSE (temp_file_name, "", "", TYPE);

                !   If the buffer is empty, then throw it away.

                IF (GET_INFO (loop_buffer, "RECORD_COUNT") > 0) THEN
                    IF (outfile = temp_file_name) OR
                                            (filename = temp_file_name) THEN
                        want_new_buffer := 0;
                    ELSE
                        want_new_buffer := 1;
                    ENDIF;
                ELSE
                    IF temp_file_name <> 0 THEN
                        vi$info ("Buffer empty, reading file");
                        POSITION (loop_buffer);
                        vi$info (FAO ('Reading "!AS"', temp_file_name));
                        file_read := READ_FILE (temp_file_name);
                        IF (file_read <> "") THEN
                            SET (OUTPUT_FILE, loop_buffer, file_read);
                            vi$status_lines (loop_buffer);
                        ENDIF;
                    ENDIF;

                    want_new_buffer := 2;
                    POSITION (BEGINNING_OF (loop_buffer));
                    MAP (CURRENT_WINDOW, loop_buffer);
                    obuf := loop_buffer;
                ENDIF;
            ENDIF;

            IF want_new_buffer = 1 THEN

                vi$info (FAO (
                            "Buffer name !AS is in use", temp_buffer_name));

                temp_buffer_name :=
                    vi$read_line (
                        "Type new buffer name or press Return to cancel: ");

                IF temp_buffer_name = "" THEN
                    vi$info ("No new buffer created");
                ELSE
                    new_buffer := vi$_create_buffer (temp_buffer_name,
                                                get_file_name, temp_file_name);
                ENDIF;
            ELSE
                IF (want_new_buffer = 0) and (CURRENT_BUFFER = loop_buffer) THEN
                    vi$info (FAO (
                                "Already editing file !AS", get_file_name));
                ELSE
                    IF (want_new_buffer = 0) THEN
                        IF (vi$check_auto_write) THEN
                            RETURN;
                        ENDIF;
                        MAP (CURRENT_WINDOW, loop_buffer);
                        obuf := loop_buffer;
                    ENDIF;
                ENDIF;
            ENDIF;
        ELSE            ! No buffer with the same name, so create a new buffer
            new_buffer := vi$_create_buffer (temp_buffer_name, get_file_name,
                                                                temp_file_name);
        ENDIF;

        IF new_buffer <> 0 THEN
            SET (EOB_TEXT, new_buffer, "[EOB]");
            SET (TAB_STOPS, new_buffer, vi$tab_amount);
        ENDIF;

        loop_cnt := loop_cnt - 1;

        EXITIF loop_cnt <= 0;

        POSITION (BEGINNING_OF (choice_buffer));
        temp_file_name := vi$current_line;
        ERASE_LINE;
    ENDLOOP;

    IF (file_cnt > 1) THEN
        vi$_first_file (0);
    ENDIF;

    vi$set_status_line (CURRENT_WINDOW);
    RETURN (file_cnt);
ENDPROCEDURE;

!
!  This procedure collects the names of all buffers that are leading
!  derivatives of "buffer_name".  The function value is the boolean
!  value telling whether or not the name matched exactly.  The other
!  parameters are return values.
!
PROCEDURE vi$choose_buffer (buffer_name, how_many_buffers,
                             possible_buffer, possible_buffer_name, loop_buffer)

    LOCAL
        this_buffer,            ! Current buffer
        loop_buffer_name,       ! String containing name of loop_buffer
        found_a_buffer;         ! True if buffer found with same exact name

    found_a_buffer := 0;
    EDIT (buffer_name, COLLAPSE);
    possible_buffer := 0;
    possible_buffer_name := 0;
    how_many_buffers := 0;

    ! See if we already have a buffer by that name

    this_buffer := CURRENT_BUFFER;
    loop_buffer := GET_INFO (BUFFERS, "FIRST");
    CHANGE_CASE (buffer_name, UPPER);   ! buffer names are uppercase
    ERASE (choice_buffer);

    LOOP
        EXITIF loop_buffer = 0;
        loop_buffer_name := GET_INFO (loop_buffer, "NAME");

        IF buffer_name = loop_buffer_name THEN
            found_a_buffer := 1;
            how_many_buffers := 1;
            EXITIF 1;
        ELSE
            IF buffer_name = SUBSTR (loop_buffer_name, 1,
                                                    LENGTH (buffer_name)) THEN
                vi$add_choice (loop_buffer_name);
                possible_buffer := loop_buffer;
                possible_buffer_name := loop_buffer_name;
                how_many_buffers := how_many_buffers + 1;
            ENDIF;
        ENDIF;

        loop_buffer := GET_INFO (BUFFERS, "NEXT");
    ENDLOOP;

    RETURN (found_a_buffer);
ENDPROCEDURE;

!
!   Return current line or empty string if at EOB
!
PROCEDURE vi$current_line
    IF (MARK (NONE) = END_OF (CURRENT_BUFFER)) THEN
        RETURN ("");
    ELSE
        RETURN (CURRENT_LINE);
    ENDIF;
ENDPROCEDURE;

!
!   If autowrite is active, then write the current buffer out.
!
PROCEDURE vi$check_auto_write
    LOCAL
        buf,
        win,
        owin,
        mod;

    mod := GET_INFO (CURRENT_BUFFER, "MODIFIED") AND
            (NOT GET_INFO (CURRENT_BUFFER, "SYSTEM")) AND
            (NOT GET_INFO (CURRENT_BUFFER, "NO_WRITE"));

    buf := CURRENT_BUFFER;

    IF mod AND vi$auto_write THEN
        IF (vi$can_write (CURRENT_BUFFER)) THEN
            vi$info ("Writing out """+GET_INFO (buf, "NAME")+"""");
            WRITE_FILE (buf);
        ELSE
            RETURN (1);
        ENDIF;
    ENDIF;

    IF (NOT mod) AND
            (NOT GET_INFO (CURRENT_BUFFER, "SYSTEM")) AND
            (NOT GET_INFO (CURRENT_BUFFER, "NO_WRITE")) AND
                                (GET_INFO (buf, "RECORD_COUNT") = 0) THEN
        IF (vi$delete_empty) THEN
            vi$info ("Deleting empty buffer: "+GET_INFO (buf, "NAME"));
            MAP (CURRENT_WINDOW, message_buffer);
            owin := CURRENT_WINDOW;
            win := GET_INFO (WINDOWS, "FIRST");
            LOOP
                EXITIF win = 0;
                IF (GET_INFO (win, "BUFFER") = buf) THEN
                    MAP (win, message_buffer);
                    vi$set_status_line (win);
                ENDIF;
                win := GET_INFO (WINDOWS, "NEXT");
            ENDLOOP;
            POSITION (owin);
            DELETE (buf);
        ELSE
            vi$last_mapped := buf;
        ENDIF;
    ELSE
        vi$last_mapped := buf;
    ENDIF;

    RETURN (0);
ENDPROCEDURE;

!
!   Only perform an update if there is not a keyboard macro in progress.
!
PROCEDURE vi$update (win)
    IF (vi$key_buf = 0) AND (vi$playing_back = 0) THEN
        UPDATE (win);
    ENDIF;
ENDPROCEDURE;

!
!   This procedure should be envoked after a wild card edit.  It will allow
!   a list of files that have been created due to a wildcard filespec to be
!   processed sequentially.
!
PROCEDURE vi$_next_file (bang)
    LOCAL
        win,
        fn,
        pos,
        found_one,
        btype,
        bn,
        how_many_buffers,
        possible_buffer,
        possible_buffer_name,
        loop_buffer,
        line;

    ON_ERROR
        ! Ignore errors
    ENDON_ERROR;

    IF (NOT bang) AND (vi$check_auto_write) THEN
        RETURN;
    ENDIF;

    pos := MARK (NONE);
    win := CURRENT_WINDOW;

    POSITION (vi$file_names);
    IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
        MOVE_VERTICAL (1);
        IF (MARK (NONE) = END_OF (CURRENT_BUFFER)) THEN
            vi$info ("No more files!");
            MOVE_VERTICAL (-1);
            POSITION (win);
            RETURN (1);
        ENDIF;
    ELSE
        vi$info ("No more files!");
        POSITION (win);
        RETURN (1);
    ENDIF;

    fn := vi$current_line;

    bn := FILE_PARSE (fn, "", "", NAME);
    btype := FILE_PARSE (fn, "", "", TYPE);

    IF btype = "" THEN
        btype := ".";
$$EOD$$