Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/misc/volume1/8710/vms-vi/12

Internet Message Format | 1990-07-13 | 35.3 KB

Path: uunet!husc6!necntc!ncoast!allbery
From: [e-mail]@mandrill.CWRU.Edu (Gregg Wonderly)
Newsgroups: comp.sources.misc
Subject: VI in TPU part 12/13
Message-ID: <[e-mail]>
Date: 13 Oct 87 02:56:04 GMT
Sender: [e-mail]
Organization: Oklahoma State Univ., Stillwater
Lines: 1331
Approved: [e-mail]
X-Archive: comp.sources.misc/8710/vms-vi/12

$ WRITE SYS$OUTPUT "Creating ""VI.11"""
$ CREATE VI.11
$ DECK/DOLLARS=$$EOD$$
    file_cnt := loop_cnt;

    LOOP

        POSITION (obuf);

        ! 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 <> "") THE
N
                            vi$message ("Buffer empty, reading file");
                            POSITION (loop_buffer);
                            vi$message (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);
                    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$message ("Buffer empty, reading file");
                        POSITION (loop_buffer);
                        vi$message (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);
                ENDIF;
            ENDIF;

            IF want_new_buffer = 1 THEN

                vi$message (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$message ("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) THE
N
                    vi$message (FAO (
                                "Already editing file !AS", get_file_name));
                ELSE
                    IF (want_new_buffer = 0) THEN
                        vi$check_auto_write;
                        MAP (CURRENT_WINDOW, 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;
    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
        how_many_buffers;       ! Number of buffers listed in possible_names

    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
    vi$last_mapped := CURRENT_BUFFER;

    IF GET_INFO (CURRENT_BUFFER, "MODIFIED") AND vi$auto_write AND
                        NOT GET_INFO (CURRENT_BUFFER, "SYSTEM") AND
                                NOT GET_INFO (CURRENT_BUFFER, "NO_WRITE") THEN
        vi$message ("Writing out """+GET_INFO (CURRENT_BUFFER, "NAME")+"""");
        WRITE_FILE (CURRENT_BUFFER);
    ENDIF;
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 GET FILE command.  It will allow
!   a list of files that have been created due to a wildcard filespec to be
!   processed sequentially.
!
PROCEDURE vi$_next_file
    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;

    vi$check_auto_write;
    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$message ("No more files!");
            MOVE_VERTICAL (-1);
            POSITION (win);
            RETURN (1);
        ENDIF;
    ELSE
        vi$message ("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 := ".";
    ENDIF;
    bn := bn + btype;

    found_one := vi$choose_buffer (bn, how_many_buffers,
                            possible_buffer, possible_buffer_name, loop_buffer)
;

    IF (found_one) THEN
        POSITION (pos);
        IF (CURRENT_BUFFER = loop_buffer) THEN
            vi$message ("Already positioned in that buffer");
        ELSE
            vi$check_auto_write;
            UNMAP (win);
            MAP (win, loop_buffer);
            vi$set_status_line (CURRENT_WINDOW);
        ENDIF;
    ELSE
        vi$message (FAO (
            "No such buffer ""!AS"", buffer has been deleted!", bn));
        POSITION (vi$file_names);
        MOVE_VERTICAL (1);
    ENDIF;

    POSITION (win);
    vi$kill_undo;
    vi$undo_end := 0;
    RETURN (1);
ENDPROCEDURE

!
!   This procedure should be envoked after a GET FILE command.  It will allow
!   a list of files that have been created due to a wildcard filespec to be
!   processed sequentially.
!
PROCEDURE vi$_previous_file
    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;

    vi$check_auto_write;
    pos := MARK (NONE);
    win := CURRENT_WINDOW;

    fn := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE");

    POSITION (vi$file_names);
    IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
        IF (MARK (NONE) = END_OF (CURRENT_BUFFER)) THEN
            MOVE_VERTICAL (-1);
        ENDIF;
        MOVE_VERTICAL (-1);
    ELSE
        vi$message ("No previous file!");
        POSITION (pos);
        RETURN (1);
    ENDIF;

    fn := vi$current_line;

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

    IF btype = "" THEN
        btype := ".";
    ENDIF;
    bn := bn + btype;

    found_one := vi$choose_buffer (bn, how_many_buffers,
                            possible_buffer, possible_buffer_name, loop_buffer)
;

    IF (found_one) THEN
        POSITION (pos);
        IF (CURRENT_BUFFER = loop_buffer) THEN
            vi$message ("Already positioned in that buffer");
        ELSE
            vi$check_auto_write;
            UNMAP (win);
            MAP (win, loop_buffer);
            vi$set_status_line (CURRENT_WINDOW);
        ENDIF;
    ELSE
        vi$message ("No previous file!");
    ENDIF;

    vi$kill_undo;
    vi$undo_end := 0;
    POSITION (win);
    RETURN (1);
ENDPROCEDURE

!
!   Map first file in file list to the current window, providing it make
!   sense to do so (eg. no mapping should be done to the command window.
!
PROCEDURE vi$_first_file
    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;

    vi$check_auto_write;
    pos := MARK (NONE);
    win := CURRENT_WINDOW;

    POSITION (BEGINNING_OF (vi$file_names));
    IF (MARK (NONE) = END_OF (vi$file_names)) THEN
        vi$message ("No filename list!");
        POSITION (pos);
        RETURN (1);
    ENDIF;

    fn := vi$current_line;

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

    IF btype = "" THEN
        btype := ".";
    ENDIF;

    bn := bn + btype;

    found_one := vi$choose_buffer (bn, how_many_buffers,
                            possible_buffer, possible_buffer_name, loop_buffer)
;

    IF (found_one) THEN
        POSITION (pos);
        IF (CURRENT_BUFFER = loop_buffer) THEN
            vi$message ("Already positioned in that buffer");
        ELSE
            vi$check_auto_write;
            UNMAP (win);
            MAP (win, loop_buffer);
            vi$set_status_line (CURRENT_WINDOW);
        ENDIF;
    ELSE
        vi$message ("Buffer not found: " + bn + "!");
    ENDIF;

    vi$kill_undo;
    vi$undo_end := 0;
    POSITION (win);
    RETURN (1);
ENDPROCEDURE;

!
!   Show the contents of the tags buffer
!
PROCEDURE vi$_show_tags
    vi$show_list (vi$tag_buf,
        "Current tags from the files: "+vi$tag_files, info_window)
ENDPROCEDURE;

!
!   Show the list of filenames currently being used by the NEXT FILE, FIRST
!   FILE, and PREVIOUS FILE commands.
!
PROCEDURE vi$_show_files
    vi$show_list (vi$file_names,
"  File names currently active for PREVIOUS, FIRST and NEXT line mode commands"
,
        info_window)

ENDPROCEDURE;

!
!   Show a buffer, dbuf, in a window, dwin, with the status line set to 'stat'.
!   Allow scrolling around, but no editing.  <ENTER> gets you out.
!
PROCEDURE vi$show_list (dbuf, stat, dwin)

    LOCAL
        this_key,
        win,
        pos;

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

    MAP (dwin, dbuf);
    SET (STATUS_LINE, dwin, NONE, "");
    SET (STATUS_LINE, dwin, REVERSE, stat);
    POSITION (dwin);
    SET (EOB_TEXT, dbuf,
"[Press RETURN to continue editing]                        ");
    UPDATE (dwin);

    LOOP
        this_key := vi$read_a_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 (CURRENT_WINDOW);
        ENDIF;
    ENDLOOP;

    UNMAP (dwin);
    SET (STATUS_LINE, dwin, NONE, "");
    SET (EOB_TEXT, dbuf, "");
    POSITION (win);
    POSITION (pos);
    vi$message ("");
ENDPROCEDURE;

!
!   This procedure creates a new buffer with the named file in it.
!   Checking is done to see if the input file exists, and CREATE was on
!   the command line, etc...
!
PROCEDURE vi$_create_buffer (buffer_name, req_name, actual_file_name)

    LOCAL
        info,
        succ,
        outf,
        new_buffer;     ! Buffer created

    ON_ERROR
        IF ERROR = TPU$_DUPBUFNAME THEN
            vi$message (FAO ("Buffer !AS already exists", buffer_name));
            RETURN (0);
        ENDIF;
    ENDON_ERROR;

    IF (actual_file_name = 0) OR (actual_file_name = "") THEN
        new_buffer := CREATE_BUFFER (buffer_name);

        IF (req_name <> 0) THEN
            outf := FILE_PARSE (req_name);
            MESSAGE (outf);
            vi$message (FAO ("New file ""!AS""", outf));
            SET (OUTPUT_FILE, new_buffer, outf);
        ENDIF;
    ELSE
        vi$message ("Reading file """+actual_file_name+"""");
        new_buffer := CREATE_BUFFER (buffer_name, actual_file_name);

        vi$message (FAO ("""!AS"", !UL lines", actual_file_name,
            GET_INFO (new_buffer, "RECORD_COUNT")));

        IF (vi$starting_up) THEN
            IF GET_INFO (COMMAND_LINE, "OUTPUT") THEN
                SET (OUTPUT_FILE, new_buffer, FILE_PARSE (
                    GET_INFO (COMMAND_LINE, "OUTPUT_FILE"),
                    actual_file_name));

                !  Set the buffer to be modified so that the file will
                !  be written on exit.

                SPLIT_LINE;
                APPEND_LINE;
            ENDIF;
        ELSE
            SET (OUTPUT_FILE, new_buffer, actual_file_name);
        ENDIF;
    ENDIF;

    vi$check_auto_write;
    MAP (CURRENT_WINDOW, new_buffer);
    vi$status_lines (new_buffer);

    IF GET_INFO (COMMAND_LINE, "READ_ONLY") THEN
        SET (NO_WRITE, new_buffer);
    ENDIF;

    SET (TAB_STOPS, new_buffer, vi$tab_amount);

    RETURN (new_buffer);
ENDPROCEDURE;

!
!   Add a string to the end of the choice buffer
!
PROCEDURE vi$add_choice (choice_string)

    LOCAL
        pos;        ! Current position in the buffer

    pos := MARK (NONE);
    POSITION (END_OF (choice_buffer));
    COPY_TEXT (choice_string);
    POSITION (pos);
ENDPROCEDURE;

!
!   Put a message into the message window, and make sure that it is visible.
!   There appears to be problems with mapping the command_window over the
!   top of the message window that makes this kludge necessary.
!
PROCEDURE vi$message (mess)
    MESSAGE (mess);
    vi$update (message_window);
ENDPROCEDURE;

!
!   Print the system error message corresponding to the error code passed.
!
PROCEDURE vi$system_message (errno)
    MESSAGE (CALL_USER (vi$cu_getmsg, STR(errno)));
ENDPROCEDURE;

!
!  Below are the window manipulation routines.  They take care of
!  spliting and deleting windows.  The vi$prev_win and vi$next_win are
!  very VERY dependent on there not being any occusion of the windows
!  that they consider.  If a window is occluded, the results are
!  unpredictable.
!
!  Split the current window exactly where it is at
!
PROCEDURE vi$split_here

    LOCAL
        curwin,
        nextwin,
        curtop,
        curbuf,
        len,
        line,
        row,
        errno,
        newwin,
        newlen,
        newtop,
        top;

    ON_ERROR
        errno := ERROR;
        line := ERROR_LINE;
        MESSAGE ("ERROR at line: "+ STR (line));
        vi$system_message (errno);
        RETURN(1);
    ENDON_ERROR

    IF (vi$in_occlusion) THEN
        MESSAGE ("Can't split while MAKE FULL SCREEN is active");
        RETURN (1);
    ENDIF;

    curwin  :=  CURRENT_WINDOW;
    row     :=  GET_INFO (SCREEN, "CURRENT_ROW");
    top     :=  GET_INFO (curwin, "VISIBLE_TOP");
    len     :=  GET_INFO (curwin, "VISIBLE_LENGTH");

    IF (row - top < 1) OR (top + len - row < 3) THEN

        ! Check to see if the cursor can not be placed in the middle because
        ! the buffer does not have enough lines.

        IF ((GET_INFO (CURRENT_BUFFER, "RECORD_COUNT") >= len/2) AND
                (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) AND
                                (MARK (NONE) <> END_OF (CURRENT_BUFFER))) THEN
            vi$pos_in_middle (MARK(NONE));
            UPDATE (CURRENT_WINDOW);
            row := GET_INFO (SCREEN, "CURRENT_ROW");
        ELSE
            ! Not enough lines, so estimate the middle.
            row := top+(len/2)-1;
        ENDIF;

        ! Check limits again.

        IF (row - top < 1) OR (top + len - row < 3) THEN
            MESSAGE ("Can't split window");
            RETURN(1);
        ENDIF;
    ENDIF;

    curbuf := GET_INFO (curwin, "BUFFER");
    newlen := row - top + 1;
    newwin := CREATE_WINDOW (top, newlen, ON);
    newtop := row + 1;
    MAP (newwin, curbuf);
    vi$set_status_line (newwin);

    newwin := CREATE_WINDOW (newtop, len - (newtop - top), ON);
    MAP (newwin, curbuf);
    vi$set_status_line (newwin);

    UNMAP (curwin);
    DELETE (curwin);

    POSITION (newwin);
    vi$pos_in_middle (MARK(NONE));
    vi$previous_window;
    vi$pos_in_middle (MARK(NONE));

    vi$this_window := CURRENT_WINDOW;

    RETURN (0);
ENDPROCEDURE;

!
!   This procedure is used to initialize some things that are necessarily
!   changed when the editing environment changes because of window or other
!   operations.
!
PROCEDURE vi$new_env
    vi$how_much_scroll := GET_INFO (CURRENT_WINDOW, "VISIBLE_LENGTH") / 2;
    vi$new_offset := 1;
ENDPROCEDURE;

!
!  Delete the current window
!
PROCEDURE vi$delete_window
    LOCAL
        curwin;

    MESSAGE ("");
    IF (vi$in_occlusion) THEN
        IF (CURRENT_WINDOW <> vi$occluding_win) THEN
            MESSAGE ("Can't delete this window.");
            RETURN;
        ENDIF;

        UNMAP (vi$old_occ_win);
        MAP (vi$old_occ_win, CURRENT_BUFFER);
        DELETE (vi$occluding_win);
        vi$in_occlusion := 0;
        vi$set_status_line (CURRENT_WINDOW);
        vi$new_env;
    ELSE
        curwin  := GET_INFO (WINDOWS, "CURRENT");
        vi$del_win (curwin);
    ENDIF;
ENDPROCEDURE;

!
!   Do the actual work of deleting a window
!
PROCEDURE vi$del_win (curwin)

    LOCAL
        max_len,        ! Maximum length of screen minus the
                        ! command window and message window
        prevwin,        ! Window before the current
        nextwin,        ! Window below the current
        prevtop,        ! Top line of previous window
        nexttop,        ! Top line of next window
        curtop,         ! Top line of current window
        prevbuf,        ! Buffer mapped to previous window
        prevlen,        ! Length of previous window
        curlen,         ! Length of current window
        nextbuf,        ! Buffer mapped to next window
        nextend,        ! Last line of next window
        newwin,
        nextlen;        ! Length of next window

    max_len := vi$scr_length - 2;
    prevwin := vi$prev_win (curwin);
    nextwin := vi$next_win (curwin);
    curlen  := GET_INFO (curwin, "VISIBLE_LENGTH");
    curtop  := GET_INFO (curwin, "VISIBLE_TOP");

    IF (nextwin <> 0) THEN
        nextend := GET_INFO (nextwin, "VISIBLE_BOTTOM");
    ELSE
        nextend := max_len+1;  ! Something greater than the max_len used below
    ENDIF;

    IF (nextwin <> 0) AND (nextend <= max_len) THEN
        nextlen := GET_INFO (nextwin, "VISIBLE_LENGTH");
        nextbuf := GET_INFO (nextwin, "BUFFER");
        newwin := CREATE_WINDOW (curtop, curlen+nextlen, ON);
        UNMAP (curwin);
        UNMAP (nextwin);
        MAP (newwin, nextbuf);
        vi$set_status_line (newwin);
        DELETE (curwin);
        DELETE (nextwin);
    ELSE
        IF (prevwin <> 0) THEN
            prevlen := GET_INFO (prevwin, "VISIBLE_LENGTH");
            prevbuf := GET_INFO (prevwin, "BUFFER");
            prevtop := GET_INFO (prevwin, "VISIBLE_TOP");
            newwin := CREATE_WINDOW (prevtop, curlen+prevlen, ON);
            UNMAP (curwin);
            UNMAP (prevwin);
            MAP (newwin, prevbuf);
            vi$set_status_line (newwin);
            DELETE (curwin);
            DELETE (prevwin);
        ELSE
            MESSAGE ("Can't delete this window");
            RETURN;
        ENDIF;
    ENDIF;

    IF (vi$prev_win (CURRENT_WINDOW) = 0) THEN
        IF (vi$next_win (CURRENT_WINDOW) = 0) THEN
            SET (STATUS_LINE, CURRENT_WINDOW, NONE, "");
            REFRESH;
        ENDIF;
    ENDIF;
    vi$this_window := CURRENT_WINDOW;
    vi$pos_in_middle (MARK (NONE));
    vi$new_env;

ENDPROCEDURE;

!
!   Take the current buffer (if there is more than one window displayed on the
!   screen), and remap it to a new window that occludes all others and is
!   the size of the screen.
!
PROCEDURE vi$make_full_screen

    LOCAL
        win,
        buf;

    IF (vi$in_occlusion) THEN
        MESSAGE ("Already in full screen");
        RETURN;
    ENDIF;

    IF (vi$next_win (CURRENT_WINDOW) = 0) THEN
        IF (vi$prev_win (CURRENT_WINDOW) = 0) THEN
            MESSAGE ("Current window is only window");
            RETURN;
        ENDIF;
    ENDIF;

    vi$old_occ_win := CURRENT_WINDOW;

    buf := CURRENT_BUFFER;
    win := CREATE_WINDOW (1, vi$scr_length - 1, ON);
    vi$occluding_win := win;

    IF (win <> 0) THEN
        vi$in_occlusion := 1;
        SET (STATUS_LINE, win, NONE, "");
        MAP (win, buf);
        vi$pos_in_middle (MARK (NONE));
        vi$new_env;
    ELSE
        MESSAGE ("Error creating window, command aborted!");
    ENDIF;

ENDPROCEDURE;

!
!  Move to next window going down the screen
!
PROCEDURE vi$next_window

    LOCAL
        nextwin,
        curwin;

    IF (vi$in_occlusion) THEN
        RETURN;
    ENDIF;

    curwin := CURRENT_WINDOW;
    nextwin := vi$next_win (curwin);

    IF (nextwin <> 0) THEN
        UPDATE (curwin);
        POSITION (nextwin);
        vi$set_status_line (nextwin);
        vi$new_env;
    ENDIF;

ENDPROCEDURE;

!
!  Move to previous window going up the screen
!
PROCEDURE vi$previous_window

    LOCAL
        prevwin,
        curwin;

    IF (vi$in_occlusion) THEN
        RETURN;
    ENDIF;

    curwin := CURRENT_WINDOW;
    prevwin := vi$prev_win (curwin);

    IF (prevwin <> 0) THEN
        UPDATE (curwin);
        POSITION (prevwin);
        vi$set_status_line (prevwin);
        vi$new_env;
    ENDIF;

ENDPROCEDURE;

!
!   Return the window that is below the current one, or ZERO if there is
!   none.  Note the special case that occurs while MAKE_FULL_SCREEN is active.
!
PROCEDURE vi$next_win (win)

    LOCAL
        winbot,
        nexttop,
        nextwin;

    IF (vi$in_occlusion) THEN
        RETURN (0);
    ENDIF;

    nextwin := GET_INFO (WINDOWS, "FIRST");
    winbot := GET_INFO (win, "VISIBLE_BOTTOM");

    IF (winbot >= (vi$scr_length - 3)) THEN
        RETURN (0);
    ENDIF;

    LOOP

        EXITIF nextwin = 0;

        IF (GET_INFO (nextwin, "BUFFER") <> 0) THEN
            nexttop := GET_INFO (nextwin, "VISIBLE_TOP");

            IF (winbot + 2 = nexttop) THEN
                RETURN (nextwin);
            ENDIF;
        ENDIF;

        nextwin := GET_INFO (nextwin, "NEXT");
    ENDLOOP;

    RETURN (0);

ENDPROCEDURE;

!
!   Return the window that is above the current one, or ZERO if there is
!   none.  Note the special case that occurs while MAKE_FULL_SCREEN is active.
!
PROCEDURE vi$prev_win (win)

    LOCAL
        max_len,    ! Maximum length of screen minus the
                    ! command window, and message window.
        wintop,
        prevbot,
        prevwin;

    IF (vi$in_occlusion) THEN
        RETURN(0);
    ENDIF;

    max_len := vi$scr_length - 1;
    prevwin := GET_INFO (WINDOWS, "FIRST");
    wintop := GET_INFO (win, "VISIBLE_TOP");

    IF (max_len <= wintop) THEN
        RETURN (0);
    ENDIF;

    IF (max_len - 1 = GET_INFO (win, "VISIBLE_BOTTOM")) AND (wintop = 1) THEN
        RETURN (0);
    ENDIF;

    LOOP
        EXITIF prevwin = 0;

        IF (GET_INFO (prevwin, "BUFFER") <> 0) THEN
            prevbot := GET_INFO (prevwin, "VISIBLE_BOTTOM");

            IF (prevbot + 2 = wintop) THEN
                RETURN (prevwin);
            ENDIF;
        ENDIF;

        prevwin := GET_INFO (prevwin, "NEXT");
    ENDLOOP;

    RETURN (0);

ENDPROCEDURE;

!
!   Shrink the current window, lengthing the lower window if possible first.
!   If there is no window below, then try above.  If can't do that either,
!   then give up with a message
!
PROCEDURE vi$shrink_window (shrinkparm)

    LOCAL
        curwin,
        currow,
        prevwin,
        nextwin,
        newshrink;

    IF (vi$in_occlusion) THEN
        RETURN;
    ENDIF;

    newshrink := shrinkparm;

    curwin := GET_INFO (WINDOWS, "CURRENT");
    currow := GET_INFO (curwin, "VISIBLE_LENGTH");

    IF (currow < 3) THEN
        MESSAGE ("Can't shrink this window");
        RETURN;
    ENDIF;

    IF newshrink > currow - 2 THEN
        newshrink := currow - 2;
    ENDIF;

    IF newshrink <= 0 THEN
        MESSAGE ("Can't shrink this window");
        RETURN;
    ENDIF;

    nextwin := vi$next_win (curwin);
    prevwin := vi$prev_win (curwin);

    IF (nextwin <> 0) THEN
        ADJUST_WINDOW (curwin, 0, -newshrink);
        ADJUST_WINDOW (nextwin, -newshrink, 0);
    ELSE
        IF (prevwin <> 0) THEN
            ADJUST_WINDOW (curwin, newshrink, 0);
            ADJUST_WINDOW (prevwin, 0, newshrink);
        ELSE
            MESSAGE ("Can't shrink this window");
            RETURN;
        ENDIF;
    ENDIF;
    POSITION (curwin);
    vi$pos_in_middle (MARK(NONE));
ENDPROCEDURE;

!
!   Enlarge the current window if possible.  Try moving the bottom down.
!   If that doesn't work, then try moving the top up.
!
PROCEDURE vi$enlarge_window (enlargeparm)

    LOCAL
        curwin,
        prevwin,
        nextwin,
        nextrow,
        newenlarge,
        prevrow;

    IF (vi$in_occlusion) THEN
        RETURN;
    ENDIF;

    newenlarge := enlargeparm;

    curwin := GET_INFO (WINDOWS, "CURRENT");

    nextwin := vi$next_win (curwin);
    prevwin := vi$prev_win (curwin);

    IF (nextwin <> 0) THEN
        nextrow := GET_INFO (nextwin, "VISIBLE_LENGTH");

        IF (nextrow > 2) then
            IF (newenlarge + 2 > nextrow) THEN
                newenlarge := nextrow - 2;
            ENDIF;

            IF newenlarge <= 0 THEN
                MESSAGE ("Can't enlarge this window");
                RETURN;
            ENDIF;

            ADJUST_WINDOW (nextwin, newenlarge, 0);
            ADJUST_WINDOW (curwin, 0, newenlarge);
        ELSE
            MESSAGE ("Can't shrink next window");
            RETURN;
        ENDIF;
    ELSE
        IF (prevwin <> 0) THEN

            prevrow := GET_INFO (prevwin, "VISIBLE_LENGTH");

            IF (prevrow < 3) THEN
                MESSAGE ("Can't shrink previous window");
                RETURN;
            ENDIF;

            IF (newenlarge + 2 > prevrow) THEN
                newenlarge := prevrow - 2;
            ENDIF;

            IF newenlarge = 0 THEN
                MESSAGE ("Can't enlarge this window");
                RETURN;
            ENDIF;

            ADJUST_WINDOW (prevwin, 0, -newenlarge);
            ADJUST_WINDOW (curwin, -newenlarge, 0);
        ELSE
            MESSAGE ("Can't enlarge this window");
            RETURN;
        ENDIF;
    ENDIF;

    POSITION (curwin);
    vi$pos_in_middle (MARK(NONE));
ENDPROCEDURE;

!
!   Set the status line for the window passed
!
PROCEDURE vi$set_status_line (win)
    LOCAL
        nowr,
        buf,
        fmtstr,
        fn;

    IF (GET_INFO (win, "STATUS_VIDEO") <> REVERSE) THEN
        RETURN;
    ENDIF;

    buf := GET_INFO (win, "BUFFER");
    nowr := " ";
    IF (GET_INFO (buf, "NO_WRITE")) THEN
        nowr := "*";
    ENDIF;
    fn := GET_INFO (buf, "NAME");
    SET (STATUS_LINE, win, NONE, "");
    fmtstr := "!" + STR (GET_INFO (win, "WIDTH"));
    SET (STATUS_LINE, win, REVERSE,
            FAO (fmtstr+"<!ASBuffer: !AS!>", nowr, fn));
ENDPROCEDURE;

!
!   Position the location passed into the middle of the current window.
!
PROCEDURE vi$pos_in_middle (pos)
    LOCAL
        scroll_top,
        scroll_bottom,
        cur_window,
        scroll_amount,
        scrl_value;

    ON_ERROR
    ENDON_ERROR;

    cur_window    := CURRENT_WINDOW;
    scrl_value    := (GET_INFO (cur_window, "VISIBLE_LENGTH") / 2);

    POSITION (pos);
    MOVE_VERTICAL (-scrl_value);
    vi$update (cur_window);
    POSITION (pos);
ENDPROCEDURE;

!
!   Update the status lines for windows with the buffer passed mapped to them
!
PROCEDURE vi$status_lines (buf)
    LOCAL
        win;

    win := GET_INFO (WINDOWS, "FIRST");
    LOOP
        EXITIF (win = 0);
        IF (GET_INFO (win, "BUFFER") = buf) THEN
            vi$set_status_line (win);
        ENDIF;
        win := GET_INFO (WINDOWS, "NEXT");
    ENDLOOP;
ENDPROCEDURE;

!
!   Send the string passed to a DCL process.  All the necessary stuff is
!   done to move to the DCL buffer, and start the DCL process, and all
!   of the other junk.
!
PROCEDURE vi$send_to_dcl (dcl_string)

    ON_ERROR
        IF ERROR = TPU$_CREATEFAIL THEN
            MESSAGE ("DCL subprocess could not be created");
            RETURN (1);
        ENDIF;
    ENDON_ERROR;

    IF CURRENT_BUFFER <> vi$dcl_buf THEN

        IF (GET_INFO (vi$dcl_buf, "MAP_COUNT") > 0) AND
                (vi$in_occlusion = 0) THEN
            POSITION (vi$dcl_buf);
        ELSE

            ! Attempt to split the screen at the cursor position

            IF (vi$split_here = 1) THEN
                IF (vi$in_occlusion = 0) THEN
                    MESSAGE ("Move cursor to middle of current window");
                ENDIF;
                RETURN (1);
            ENDIF;

            MAP (CURRENT_WINDOW, vi$dcl_buf);
        ENDIF;
    ENDIF;

    POSITION (END_OF (vi$dcl_buf));
    vi$status_lines (CURRENT_BUFFER);
    UPDATE (CURRENT_WINDOW);

    IF (GET_INFO (vi$dcl_process, "TYPE") = UNSPECIFIED) OR
                                               (vi$dcl_process = 0) THEN
        MESSAGE ("Creating DCL subprocess...");
        vi$dcl_process := CREATE_PROCESS (vi$dcl_buf);
        IF (vi$dcl_process = 0) THEN
            RETURN;
        ENDIF;
        MESSAGE ("Process was created");
    ENDIF;

    SPLIT_LINE;
    COPY_TEXT (dcl_string);
    UPDATE (CURRENT_WINDOW);
    SEND (dcl_string, vi$dcl_process);
    POSITION (END_OF (vi$dcl_buf));
    UPDATE (CURRENT_WINDOW);

    RETURN (0);
ENDPROCEDURE;

!
!
!
PROCEDURE vi$mess_select (mode)
    LOCAL
        pos;

    pos := MARK (NONE);
    vi$message_select := 0;
    POSITION (END_OF (message_buffer));
    vi$message_select := SELECT (mode);
    POSITION (pos);
ENDPROCEDURE;

!
!  Allow local modifications to be done here.
!
PROCEDURE tpu$local_init
ENDPROCEDURE;

!
!   Create a section file, and terminate.
!
vi$init_keys;
COMPILE ("PROCEDURE vi$init_keys ENDPROCEDURE;");
SAVE ("SYS$DISK:[]VI.GBL");
QUIT;
$$EOD$$