[comp.os.vms] VI in TPU part 13/14

gregg@a.cs.okstate.edu (Gregg Wonderly) (10/21/87)

$!=============================================================================
$! VAX/VMS archive file created by VMS_SHAR V-4.03 05-Aug-1987
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by GREGG
$!      on Tuesday 20-OCT-1987 22:47:09.02
$!
$! It contains the following 1 file:
$! VI.11
$!=============================================================================
$ Set Symbol/Scope=(NoLocal,NoGlobal)
$ Version=F$GetSYI("VERSION") ! See what VMS version we have here:
$ If Version.ges."V4.4" then goto Version_OK
$ Write SYS$Output "Sorry, you are running VMS ",Version, -
                ", but this procedure requires V4.4 or higher."
$ Exit 44
$Version_OK: CR[0,8]=13
$ Pass_or_Failed="failed!,passed."
$ Goto Start
$Convert_File:
$ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1: Define/User_Mode SYS$Output NL:
$ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
        VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set (Output_File,b,o);
Position (Beginning_of(b));Loop x:=Erase_Character(1); Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;Move_Horizontal
(-Current_Offset);EndLoop;Move_Vertical(1);ExitIf Mark(None)=End_of(b)
EndLoop;Exit;
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'File_is
$ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2: Return
$Start:
$ File_is="VI.11"
$ Check_Sum_is=1549679047
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X    file_cnt := loop_cnt;
X
X    LOOP
X
X        POSITION (obuf);
X
X        ! See if we already have a buffer by that name
X
X        IF temp_file_name = 0 THEN
X            temp_buffer_name :=
X                FILE_PARSE (get_file_name, "", "", NAME) +
X                FILE_PARSE (get_file_name, "", "", TYPE);
X        ELSE
X            temp_buffer_name :=
X                FILE_PARSE (temp_file_name, "", "", NAME) +
X                FILE_PARSE (temp_file_name, "", "", TYPE);
X        ENDIF;
X
X        IF get_file_parm <> 0 THEN
X
X            !  Trim the trailing dot off.
X
X            EDIT (get_file_parm, UPPER, COLLAPSE);
X
X            IF (SUBSTR (get_file_parm, LENGTH(get_file_parm), 1)
X                                                                <> '.') THEN
X                IF (SUBSTR (temp_buffer_name,
X                                LENGTH(temp_buffer_name), 1) = '.') THEN
X
X                    temp_buffer_name :=
X                        SUBSTR (temp_buffer_name, 1,
X                                                LENGTH(temp_buffer_name)-1);
X                ENDIF;
X            ENDIF;
X        ENDIF;
X
X        loop_buffer := GET_INFO (BUFFERS, "FIRST");
X        found_a_buffer := 0;
X
X        LOOP
X            EXITIF loop_buffer = 0;
X            IF temp_buffer_name = GET_INFO (loop_buffer, "NAME") THEN
X                found_a_buffer := 1;
X                EXITIF 1;
X            ENDIF;
X            loop_buffer := GET_INFO (BUFFERS, "NEXT");
X        ENDLOOP;
X
X        ! If there is a buffer by that name, is it the same file?
X        ! We ignore version numbers to keep our sanity
X
X        IF found_a_buffer THEN      ! Have a buffer with the same name
X            IF temp_file_name = 0 THEN  ! No file on disk
X                IF get_file_name = GET_INFO (loop_buffer, "OUTPUT_FILE") THEN
X                    want_new_buffer := 0;
X                ELSE
X
X                    !   If the buffer is empty, then throw it
X                    !   away.
X
X                    IF (GET_INFO (loop_buffer, "RECORD_COUNT") > 0) THEN
X                        want_new_buffer := 0;
X                    ELSE
V                        IF (temp_file_name <> 0) and (temp_file_name <> "") TH
XEN
X                            vi$message ("Buffer empty, reading file");
X                            POSITION (loop_buffer);
V                            vi$message (FAO ('Reading "!AS"', temp_file_name))
X;
X                            file_read := READ_FILE (temp_file_name);
X
X                            IF file_read <> "" THEN
X                                SET (OUTPUT_FILE, loop_buffer, file_read);
X                                vi$status_lines (loop_buffer);
X                            ENDIF;
X                        ENDIF;
X
X                        want_new_buffer := 2;
X                        POSITION (BEGINNING_OF (loop_buffer));
X                        MAP (CURRENT_WINDOW, loop_buffer);
X                    ENDIF;
X                ENDIF;
X            ELSE
X
X                ! Check to see if the same file
X
X                outfile := GET_INFO (loop_buffer, "OUTPUT_FILE");
X                filename := GET_INFO (loop_buffer, "FILE_NAME");
X
X                !  Trim version numbers off all of the names.
X
X                IF (outfile <> 0) THEN
X                    outfile := FILE_PARSE (outfile, "", "", DEVICE) +
X                                FILE_PARSE (outfile, "", "", DIRECTORY) +
X                                FILE_PARSE (outfile, "", "", NAME) +
X                                FILE_PARSE (outfile, "", "", TYPE);
X                ENDIF;
X
X                IF (filename <> 0) THEN
X                    filename := FILE_PARSE (filename, "", "", DEVICE) +
X                                FILE_PARSE (filename, "", "", DIRECTORY) +
X                                FILE_PARSE (filename, "", "", NAME) +
X                                FILE_PARSE (filename, "", "", TYPE);
X                ENDIF;
X
V                temp_file_name := FILE_PARSE (temp_file_name, "", "", DEVICE) 
X+
V                                FILE_PARSE (temp_file_name, "", "", DIRECTORY)
X +
X                                FILE_PARSE (temp_file_name, "", "", NAME) +
X                                FILE_PARSE (temp_file_name, "", "", TYPE);
X
X                !   If the buffer is empty, then throw it away.
X
X                IF (GET_INFO (loop_buffer, "RECORD_COUNT") > 0) THEN
X                    IF (outfile = temp_file_name) OR
X                                            (filename = temp_file_name) THEN
X                        want_new_buffer := 0;
X                    ELSE
X                        want_new_buffer := 1;
X                    ENDIF;
X                ELSE
X                    IF temp_file_name <> 0 THEN
X                        vi$message ("Buffer empty, reading file");
X                        POSITION (loop_buffer);
X                        vi$message (FAO ('Reading "!AS"', temp_file_name));
X                        file_read := READ_FILE (temp_file_name);
X                        IF (file_read <> "") THEN
X                            SET (OUTPUT_FILE, loop_buffer, file_read);
X                            vi$status_lines (loop_buffer);
X                        ENDIF;
X                    ENDIF;
X
X                    want_new_buffer := 2;
X                    POSITION (BEGINNING_OF (loop_buffer));
X                    MAP (CURRENT_WINDOW, loop_buffer);
X                ENDIF;
X            ENDIF;
X
X            IF want_new_buffer = 1 THEN
X
X                vi$message (FAO (
X                            "Buffer name !AS is in use", temp_buffer_name));
X
X                temp_buffer_name :=
X                    vi$read_line (
X                        "Type new buffer name or press Return to cancel: ");
X
X                IF temp_buffer_name = "" THEN
X                    vi$message ("No new buffer created");
X                ELSE
X                    new_buffer := vi$_create_buffer (temp_buffer_name,
V                                                get_file_name, temp_file_name)
X;
X                ENDIF;
X            ELSE
V                IF (want_new_buffer = 0) and (CURRENT_BUFFER = loop_buffer) TH
XEN
X                    vi$message (FAO (
X                                "Already editing file !AS", get_file_name));
X                ELSE
X                    IF (want_new_buffer = 0) THEN
X                        vi$check_auto_write;
X                        MAP (CURRENT_WINDOW, loop_buffer);
X                    ENDIF;
X                ENDIF;
X            ENDIF;
X        ELSE            ! No buffer with the same name, so create a new buffer
X            new_buffer := vi$_create_buffer (temp_buffer_name, get_file_name,
V                                                                temp_file_name
X);
X        ENDIF;
X
X        IF new_buffer <> 0 THEN
X            SET (EOB_TEXT, new_buffer, "[EOB]");
X            SET (TAB_STOPS, new_buffer, vi$tab_amount);
X        ENDIF;
X
X        loop_cnt := loop_cnt - 1;
X
X        EXITIF loop_cnt <= 0;
X
X        POSITION (BEGINNING_OF (choice_buffer));
X        temp_file_name := vi$current_line;
X        ERASE_LINE;
X    ENDLOOP;
X
X    IF (file_cnt > 1) THEN
X        vi$_first_file;
X    ENDIF;
X
X    vi$set_status_line (CURRENT_WINDOW);
X    RETURN (file_cnt);
XENDPROCEDURE;
X
X!
X!  This procedure collects the names of all buffers that are leading
X!  derivatives of "buffer_name".  The function value is the boolean
X!  value telling whether or not the name matched exactly.  The other
X!  parameters are return values.
X!
XPROCEDURE vi$choose_buffer (buffer_name, how_many_buffers,
V                             possible_buffer, possible_buffer_name, loop_buffe
Xr)
X
X    LOCAL
X        this_buffer,            ! Current buffer
X        loop_buffer_name,       ! String containing name of loop_buffer
X        found_a_buffer,         ! True if buffer found with same exact name
X        how_many_buffers;       ! Number of buffers listed in possible_names
X
X    found_a_buffer := 0;
X    EDIT (buffer_name, COLLAPSE);
X    possible_buffer := 0;
X    possible_buffer_name := 0;
X    how_many_buffers := 0;
X
X    ! See if we already have a buffer by that name
X
X    this_buffer := CURRENT_BUFFER;
X    loop_buffer := GET_INFO (BUFFERS, "FIRST");
X    CHANGE_CASE (buffer_name, UPPER);   ! buffer names are uppercase
X    ERASE (choice_buffer);
X
X    LOOP
X        EXITIF loop_buffer = 0;
X        loop_buffer_name := GET_INFO (loop_buffer, "NAME");
X
X        IF buffer_name = loop_buffer_name THEN
X            found_a_buffer := 1;
X            how_many_buffers := 1;
X            EXITIF 1;
X        ELSE
X            IF buffer_name = SUBSTR (loop_buffer_name, 1,
X                                                    LENGTH (buffer_name)) THEN
X                vi$add_choice (loop_buffer_name);
X                possible_buffer := loop_buffer;
X                possible_buffer_name := loop_buffer_name;
X                how_many_buffers := how_many_buffers + 1;
X            ENDIF;
X        ENDIF;
X
X        loop_buffer := GET_INFO (BUFFERS, "NEXT");
X    ENDLOOP;
X
X    RETURN (found_a_buffer);
XENDPROCEDURE;
X
X!
X!   Return current line or empty string if at EOB
X!
XPROCEDURE vi$current_line
X    IF (MARK (NONE) = END_OF (CURRENT_BUFFER)) THEN
X        RETURN ("");
X    ELSE
X        RETURN (CURRENT_LINE);
X    ENDIF;
XENDPROCEDURE;
X
X!
X!   If autowrite is active, then write the current buffer out.
X!
XPROCEDURE vi$check_auto_write
X    vi$last_mapped := CURRENT_BUFFER;
X
X    IF GET_INFO (CURRENT_BUFFER, "MODIFIED") AND vi$auto_write AND
X                        NOT GET_INFO (CURRENT_BUFFER, "SYSTEM") AND
X                                NOT GET_INFO (CURRENT_BUFFER, "NO_WRITE") THEN
X        vi$message ("Writing out """+GET_INFO (CURRENT_BUFFER, "NAME")+"""");
X        WRITE_FILE (CURRENT_BUFFER);
X    ENDIF;
XENDPROCEDURE;
X
X!
X!   Only perform an update if there is not a keyboard macro in progress.
X!
XPROCEDURE vi$update (win)
X    IF (vi$key_buf = 0) AND (vi$playing_back = 0) THEN
X        UPDATE (win);
X    ENDIF;
XENDPROCEDURE;
X
X!
X!   This procedure should be envoked after a GET FILE command.  It will allow
X!   a list of files that have been created due to a wildcard filespec to be
X!   processed sequentially.
X!
XPROCEDURE vi$_next_file
X    LOCAL
X        win,
X        fn,
X        pos,
X        found_one,
X        btype,
X        bn,
X        how_many_buffers,
X        possible_buffer,
X        possible_buffer_name,
X        loop_buffer,
X        line;
X
X    ON_ERROR
X        ! Ignore errors
X    ENDON_ERROR;
X
X    vi$check_auto_write;
X    pos := MARK (NONE);
X    win := CURRENT_WINDOW;
X
X    POSITION (vi$file_names);
X    IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
X        MOVE_VERTICAL (1);
X        IF (MARK (NONE) = END_OF (CURRENT_BUFFER)) THEN
X            vi$message ("No more files!");
X            MOVE_VERTICAL (-1);
X            POSITION (win);
X            RETURN (1);
X        ENDIF;
X    ELSE
X        vi$message ("No more files!");
X        POSITION (win);
X        RETURN (1);
X    ENDIF;
X
X    fn := vi$current_line;
X
X    bn := FILE_PARSE (fn, "", "", NAME);
X    btype := FILE_PARSE (fn, "", "", TYPE);
X
X    IF btype = "" THEN
X        btype := ".";
X    ENDIF;
X    bn := bn + btype;
X
X    found_one := vi$choose_buffer (bn, how_many_buffers,
V                            possible_buffer, possible_buffer_name, loop_buffer
X);
X
X    IF (found_one) THEN
X        POSITION (pos);
X        IF (CURRENT_BUFFER = loop_buffer) THEN
X            vi$message ("Already positioned in that buffer");
X        ELSE
X            vi$check_auto_write;
X            UNMAP (win);
X            MAP (win, loop_buffer);
X            vi$set_status_line (CURRENT_WINDOW);
X        ENDIF;
X    ELSE
X        vi$message (FAO (
X            "No such buffer ""!AS"", buffer has been deleted!", bn));
X        POSITION (vi$file_names);
X        MOVE_VERTICAL (1);
X    ENDIF;
X
X    POSITION (win);
X    vi$kill_undo;
X    vi$undo_end := 0;
X    RETURN (1);
XENDPROCEDURE
X
X!
X!   This procedure should be envoked after a GET FILE command.  It will allow
X!   a list of files that have been created due to a wildcard filespec to be
X!   processed sequentially.
X!
XPROCEDURE vi$_previous_file
X    LOCAL
X        win,
X        fn,
X        pos,
X        found_one,
X        btype,
X        bn,
X        how_many_buffers,
X        possible_buffer,
X        possible_buffer_name,
X        loop_buffer,
X        line;
X
X    ON_ERROR
X        ! Ignore errors
X    ENDON_ERROR;
X
X    vi$check_auto_write;
X    pos := MARK (NONE);
X    win := CURRENT_WINDOW;
X
X    fn := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE");
X
X    POSITION (vi$file_names);
X    IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
X        IF (MARK (NONE) = END_OF (CURRENT_BUFFER)) THEN
X            MOVE_VERTICAL (-1);
X        ENDIF;
X        MOVE_VERTICAL (-1);
X    ELSE
X        vi$message ("No previous file!");
X        POSITION (pos);
X        RETURN (1);
X    ENDIF;
X
X    fn := vi$current_line;
X
X    bn := FILE_PARSE (fn, "", "", NAME);
X    btype := FILE_PARSE (fn, "", "", TYPE);
X
X    IF btype = "" THEN
X        btype := ".";
X    ENDIF;
X    bn := bn + btype;
X
X    found_one := vi$choose_buffer (bn, how_many_buffers,
V                            possible_buffer, possible_buffer_name, loop_buffer
X);
X
X    IF (found_one) THEN
X        POSITION (pos);
X        IF (CURRENT_BUFFER = loop_buffer) THEN
X            vi$message ("Already positioned in that buffer");
X        ELSE
X            vi$check_auto_write;
X            UNMAP (win);
X            MAP (win, loop_buffer);
X            vi$set_status_line (CURRENT_WINDOW);
X        ENDIF;
X    ELSE
X        vi$message ("No previous file!");
X    ENDIF;
X
X    vi$kill_undo;
X    vi$undo_end := 0;
X    POSITION (win);
X    RETURN (1);
XENDPROCEDURE
X
X!
X!   Map first file in file list to the current window, providing it make
X!   sense to do so (eg. no mapping should be done to the command window.
X!
XPROCEDURE vi$_first_file
X    LOCAL
X        win,
X        fn,
X        pos,
X        found_one,
X        btype,
X        bn,
X        how_many_buffers,
X        possible_buffer,
X        possible_buffer_name,
X        loop_buffer,
X        line;
X
X    ON_ERROR
X        ! Ignore errors
X    ENDON_ERROR;
X
X    vi$check_auto_write;
X    pos := MARK (NONE);
X    win := CURRENT_WINDOW;
X
X    POSITION (BEGINNING_OF (vi$file_names));
X    IF (MARK (NONE) = END_OF (vi$file_names)) THEN
X        vi$message ("No filename list!");
X        POSITION (pos);
X        RETURN (1);
X    ENDIF;
X
X    fn := vi$current_line;
X
X    bn := FILE_PARSE (fn, "", "", NAME);
X    btype := FILE_PARSE (fn, "", "", TYPE);
X
X    IF btype = "" THEN
X        btype := ".";
X    ENDIF;
X
X    bn := bn + btype;
X
X    found_one := vi$choose_buffer (bn, how_many_buffers,
V                            possible_buffer, possible_buffer_name, loop_buffer
X);
X
X    IF (found_one) THEN
X        POSITION (pos);
X        IF (CURRENT_BUFFER = loop_buffer) THEN
X            vi$message ("Already positioned in that buffer");
X        ELSE
X            vi$check_auto_write;
X            UNMAP (win);
X            MAP (win, loop_buffer);
X            vi$set_status_line (CURRENT_WINDOW);
X        ENDIF;
X    ELSE
X        vi$message ("Buffer not found: " + bn + "!");
X    ENDIF;
X
X    vi$kill_undo;
X    vi$undo_end := 0;
X    POSITION (win);
X    RETURN (1);
XENDPROCEDURE;
X
X!
X!   Show the contents of the tags buffer
X!
XPROCEDURE vi$_show_tags
X    vi$show_list (vi$tag_buf,
X        "Current tags from the files: "+vi$tag_files, info_window)
XENDPROCEDURE;
X
X!
X!   Show the list of filenames currently being used by the NEXT FILE, FIRST
X!   FILE, and PREVIOUS FILE commands.
X!
XPROCEDURE vi$_show_files
X    vi$show_list (vi$file_names,
V"  File names currently active for PREVIOUS, FIRST and NEXT line mode commands
X",
X        info_window)
X
XENDPROCEDURE;
X
X!
V!   Show a buffer, dbuf, in a window, dwin, with the status line set to 'stat'
X.
X!   Allow scrolling around, but no editing.  <ENTER> gets you out.
X!
XPROCEDURE vi$show_list (dbuf, stat, dwin)
X
X    LOCAL
X        this_key,
X        win,
X        pos;
X
X    win := CURRENT_WINDOW;
X    pos := MARK (NONE);
X
X    MAP (dwin, dbuf);
X    SET (STATUS_LINE, dwin, NONE, "");
X    SET (STATUS_LINE, dwin, REVERSE, stat);
X    POSITION (dwin);
X    SET (EOB_TEXT, dbuf,
X"[Press RETURN to continue editing]                        ");
X    UPDATE (dwin);
X
X    LOOP
X        this_key := vi$read_a_key;
X        EXITIF (this_key = RET_KEY);
X
X        IF (this_key = CTRL_D_KEY) OR
X           (this_key = CTRL_U_KEY) OR
X           (this_key = CTRL_F_KEY) OR
X           (this_key = CTRL_B_KEY) OR
X           (this_key = KEY_NAME ('h')) OR
X           (this_key = KEY_NAME ('j')) OR
X           (this_key = KEY_NAME ('k')) OR
X           (this_key = KEY_NAME ('l')) THEN
X
X            EXECUTE (LOOKUP_KEY (this_key, PROGRAM, vi$cmd_keys));
X            UPDATE (CURRENT_WINDOW);
X        ENDIF;
X    ENDLOOP;
X
X    UNMAP (dwin);
X    SET (STATUS_LINE, dwin, NONE, "");
X    SET (EOB_TEXT, dbuf, "");
X    POSITION (win);
X    POSITION (pos);
X    vi$message ("");
XENDPROCEDURE;
X
X!
X!   This procedure creates a new buffer with the named file in it.
X!   Checking is done to see if the input file exists, and CREATE was on
X!   the command line, etc...
X!
XPROCEDURE vi$_create_buffer (buffer_name, req_name, actual_file_name)
X
X    LOCAL
X        info,
X        succ,
X        outf,
X        new_buffer;     ! Buffer created
X
X    ON_ERROR
X        IF ERROR = TPU$_DUPBUFNAME THEN
X            vi$message (FAO ("Buffer !AS already exists", buffer_name));
X            RETURN (0);
X        ENDIF;
X    ENDON_ERROR;
X
X    IF (actual_file_name = 0) OR (actual_file_name = "") THEN
X        new_buffer := CREATE_BUFFER (buffer_name);
X
X        IF (req_name <> 0) THEN
X            outf := FILE_PARSE (req_name);
X            MESSAGE (outf);
X            vi$message (FAO ("New file ""!AS""", outf));
X            SET (OUTPUT_FILE, new_buffer, outf);
X        ENDIF;
X    ELSE
X        vi$message ("Reading file """+actual_file_name+"""");
X        new_buffer := CREATE_BUFFER (buffer_name, actual_file_name);
X
X        vi$message (FAO ("""!AS"", !UL lines", actual_file_name,
X            GET_INFO (new_buffer, "RECORD_COUNT")));
X
X        IF (vi$starting_up) THEN
X            IF GET_INFO (COMMAND_LINE, "OUTPUT") THEN
X                SET (OUTPUT_FILE, new_buffer, FILE_PARSE (
X                    GET_INFO (COMMAND_LINE, "OUTPUT_FILE"),
X                    actual_file_name));
X
X                !  Set the buffer to be modified so that the file will
X                !  be written on exit.
X
X                SPLIT_LINE;
X                APPEND_LINE;
X            ENDIF;
X        ELSE
X            SET (OUTPUT_FILE, new_buffer, actual_file_name);
X        ENDIF;
X    ENDIF;
X
X    vi$check_auto_write;
X    MAP (CURRENT_WINDOW, new_buffer);
X    vi$status_lines (new_buffer);
X
X    IF GET_INFO (COMMAND_LINE, "READ_ONLY") THEN
X        SET (NO_WRITE, new_buffer);
X    ENDIF;
X
X    SET (TAB_STOPS, new_buffer, vi$tab_amount);
X
X    RETURN (new_buffer);
XENDPROCEDURE;
X
X!
X!   Add a string to the end of the choice buffer
X!
XPROCEDURE vi$add_choice (choice_string)
X
X    LOCAL
X        pos;        ! Current position in the buffer
X
X    pos := MARK (NONE);
X    POSITION (END_OF (choice_buffer));
X    COPY_TEXT (choice_string);
X    POSITION (pos);
XENDPROCEDURE;
X
X!
X!   Put a message into the message window, and make sure that it is visible.
X!   There appears to be problems with mapping the command_window over the
X!   top of the message window that makes this kludge necessary.
X!
XPROCEDURE vi$message (mess)
X    MESSAGE (mess);
X    vi$update (message_window);
XENDPROCEDURE;
X
X!
X!   Print the system error message corresponding to the error code passed.
X!
XPROCEDURE vi$system_message (errno)
X    MESSAGE (CALL_USER (vi$cu_getmsg, STR(errno)));
XENDPROCEDURE;
X
X!
X!  Below are the window manipulation routines.  They take care of
X!  spliting and deleting windows.  The vi$prev_win and vi$next_win are
X!  very VERY dependent on there not being any occusion of the windows
X!  that they consider.  If a window is occluded, the results are
X!  unpredictable.
X!
X!  Split the current window exactly where it is at
X!
XPROCEDURE vi$split_here
X
X    LOCAL
X        curwin,
X        nextwin,
X        curtop,
X        curbuf,
X        len,
X        line,
X        row,
X        errno,
X        newwin,
X        newlen,
X        newtop,
X        top;
X
X    ON_ERROR
X        errno := ERROR;
X        line := ERROR_LINE;
X        MESSAGE ("ERROR at line: "+ STR (line));
X        vi$system_message (errno);
X        RETURN(1);
X    ENDON_ERROR
X
X    IF (vi$in_occlusion) THEN
X        MESSAGE ("Can't split while MAKE FULL SCREEN is active");
X        RETURN (1);
X    ENDIF;
X
X    curwin  :=  CURRENT_WINDOW;
X    row     :=  GET_INFO (SCREEN, "CURRENT_ROW");
X    top     :=  GET_INFO (curwin, "VISIBLE_TOP");
X    len     :=  GET_INFO (curwin, "VISIBLE_LENGTH");
X
X    IF (row - top < 1) OR (top + len - row < 3) THEN
X
X        ! Check to see if the cursor can not be placed in the middle because
X        ! the buffer does not have enough lines.
X
X        IF ((GET_INFO (CURRENT_BUFFER, "RECORD_COUNT") >= len/2) AND
X                (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) AND
X                                (MARK (NONE) <> END_OF (CURRENT_BUFFER))) THEN
X            vi$pos_in_middle (MARK(NONE));
X            UPDATE (CURRENT_WINDOW);
X            row := GET_INFO (SCREEN, "CURRENT_ROW");
X        ELSE
X            ! Not enough lines, so estimate the middle.
X            row := top+(len/2)-1;
X        ENDIF;
X
X        ! Check limits again.
X
X        IF (row - top < 1) OR (top + len - row < 3) THEN
X            MESSAGE ("Can't split window");
X            RETURN(1);
X        ENDIF;
X    ENDIF;
X
X    curbuf := GET_INFO (curwin, "BUFFER");
X    newlen := row - top + 1;
X    newwin := CREATE_WINDOW (top, newlen, ON);
X    newtop := row + 1;
X    MAP (newwin, curbuf);
X    vi$set_status_line (newwin);
X
X    newwin := CREATE_WINDOW (newtop, len - (newtop - top), ON);
X    MAP (newwin, curbuf);
X    vi$set_status_line (newwin);
X
X    UNMAP (curwin);
X    DELETE (curwin);
X
X    POSITION (newwin);
X    vi$pos_in_middle (MARK(NONE));
X    vi$previous_window;
X    vi$pos_in_middle (MARK(NONE));
X
X    vi$this_window := CURRENT_WINDOW;
X
X    RETURN (0);
XENDPROCEDURE;
X
X!
X!   This procedure is used to initialize some things that are necessarily
X!   changed when the editing environment changes because of window or other
X!   operations.
X!
XPROCEDURE vi$new_env
X    vi$how_much_scroll := GET_INFO (CURRENT_WINDOW, "VISIBLE_LENGTH") / 2;
X    vi$new_offset := 1;
XENDPROCEDURE;
X
X!
X!  Delete the current window
X!
XPROCEDURE vi$delete_window
X    LOCAL
X        curwin;
X
X    MESSAGE ("");
X    IF (vi$in_occlusion) THEN
X        IF (CURRENT_WINDOW <> vi$occluding_win) THEN
X            MESSAGE ("Can't delete this window.");
X            RETURN;
X        ENDIF;
X
X        UNMAP (vi$old_occ_win);
X        MAP (vi$old_occ_win, CURRENT_BUFFER);
X        DELETE (vi$occluding_win);
X        vi$in_occlusion := 0;
X        vi$set_status_line (CURRENT_WINDOW);
X        vi$new_env;
X    ELSE
X        curwin  := GET_INFO (WINDOWS, "CURRENT");
X        vi$del_win (curwin);
X    ENDIF;
XENDPROCEDURE;
X
X!
X!   Do the actual work of deleting a window
X!
XPROCEDURE vi$del_win (curwin)
X
X    LOCAL
X        max_len,        ! Maximum length of screen minus the
X                        ! command window and message window
X        prevwin,        ! Window before the current
X        nextwin,        ! Window below the current
X        prevtop,        ! Top line of previous window
X        nexttop,        ! Top line of next window
X        curtop,         ! Top line of current window
X        prevbuf,        ! Buffer mapped to previous window
X        prevlen,        ! Length of previous window
X        curlen,         ! Length of current window
X        nextbuf,        ! Buffer mapped to next window
X        nextend,        ! Last line of next window
X        newwin,
X        nextlen;        ! Length of next window
X
X    max_len := vi$scr_length - 2;
X    prevwin := vi$prev_win (curwin);
X    nextwin := vi$next_win (curwin);
X    curlen  := GET_INFO (curwin, "VISIBLE_LENGTH");
X    curtop  := GET_INFO (curwin, "VISIBLE_TOP");
X
X    IF (nextwin <> 0) THEN
X        nextend := GET_INFO (nextwin, "VISIBLE_BOTTOM");
X    ELSE
X        nextend := max_len+1;  ! Something greater than the max_len used below
X    ENDIF;
X
X    IF (nextwin <> 0) AND (nextend <= max_len) THEN
X        nextlen := GET_INFO (nextwin, "VISIBLE_LENGTH");
X        nextbuf := GET_INFO (nextwin, "BUFFER");
X        newwin := CREATE_WINDOW (curtop, curlen+nextlen, ON);
X        UNMAP (curwin);
X        UNMAP (nextwin);
X        MAP (newwin, nextbuf);
X        vi$set_status_line (newwin);
X        DELETE (curwin);
X        DELETE (nextwin);
X    ELSE
X        IF (prevwin <> 0) THEN
X            prevlen := GET_INFO (prevwin, "VISIBLE_LENGTH");
X            prevbuf := GET_INFO (prevwin, "BUFFER");
X            prevtop := GET_INFO (prevwin, "VISIBLE_TOP");
X            newwin := CREATE_WINDOW (prevtop, curlen+prevlen, ON);
X            UNMAP (curwin);
X            UNMAP (prevwin);
X            MAP (newwin, prevbuf);
X            vi$set_status_line (newwin);
X            DELETE (curwin);
X            DELETE (prevwin);
X        ELSE
X            MESSAGE ("Can't delete this window");
X            RETURN;
X        ENDIF;
X    ENDIF;
X
X    IF (vi$prev_win (CURRENT_WINDOW) = 0) THEN
X        IF (vi$next_win (CURRENT_WINDOW) = 0) THEN
X            SET (STATUS_LINE, CURRENT_WINDOW, NONE, "");
X            REFRESH;
X        ENDIF;
X    ENDIF;
X    vi$this_window := CURRENT_WINDOW;
X    vi$pos_in_middle (MARK (NONE));
X    vi$new_env;
X
XENDPROCEDURE;
X
X!
X!   Take the current buffer (if there is more than one window displayed on the
X!   screen), and remap it to a new window that occludes all others and is
X!   the size of the screen.
X!
XPROCEDURE vi$make_full_screen
X
X    LOCAL
X        win,
X        buf;
X
X    IF (vi$in_occlusion) THEN
X        MESSAGE ("Already in full screen");
X        RETURN;
X    ENDIF;
X
X    IF (vi$next_win (CURRENT_WINDOW) = 0) THEN
X        IF (vi$prev_win (CURRENT_WINDOW) = 0) THEN
X            MESSAGE ("Current window is only window");
X            RETURN;
X        ENDIF;
X    ENDIF;
X
X    vi$old_occ_win := CURRENT_WINDOW;
X
X    buf := CURRENT_BUFFER;
X    win := CREATE_WINDOW (1, vi$scr_length - 1, ON);
X    vi$occluding_win := win;
X
X    IF (win <> 0) THEN
X        vi$in_occlusion := 1;
X        SET (STATUS_LINE, win, NONE, "");
X        MAP (win, buf);
X        vi$pos_in_middle (MARK (NONE));
X        vi$new_env;
X    ELSE
X        MESSAGE ("Error creating window, command aborted!");
X    ENDIF;
X
XENDPROCEDURE;
X
X!
X!  Move to next window going down the screen
X!
XPROCEDURE vi$next_window
X
X    LOCAL
X        nextwin,
X        curwin;
X
X    IF (vi$in_occlusion) THEN
X        RETURN;
X    ENDIF;
X
X    curwin := CURRENT_WINDOW;
X    nextwin := vi$next_win (curwin);
X
X    IF (nextwin <> 0) THEN
X        UPDATE (curwin);
X        POSITION (nextwin);
X        vi$set_status_line (nextwin);
X        vi$new_env;
X    ENDIF;
X
XENDPROCEDURE;
X
X!
X!  Move to previous window going up the screen
X!
XPROCEDURE vi$previous_window
X
X    LOCAL
X        prevwin,
X        curwin;
X
X    IF (vi$in_occlusion) THEN
X        RETURN;
X    ENDIF;
X
X    curwin := CURRENT_WINDOW;
X    prevwin := vi$prev_win (curwin);
X
X    IF (prevwin <> 0) THEN
X        UPDATE (curwin);
X        POSITION (prevwin);
X        vi$set_status_line (prevwin);
X        vi$new_env;
X    ENDIF;
X
XENDPROCEDURE;
X
X!
X!   Return the window that is below the current one, or ZERO if there is
X!   none.  Note the special case that occurs while MAKE_FULL_SCREEN is active.
X!
XPROCEDURE vi$next_win (win)
X
X    LOCAL
X        winbot,
X        nexttop,
X        nextwin;
X
X    IF (vi$in_occlusion) THEN
X        RETURN (0);
X    ENDIF;
X
X    nextwin := GET_INFO (WINDOWS, "FIRST");
X    winbot := GET_INFO (win, "VISIBLE_BOTTOM");
X
X    IF (winbot >= (vi$scr_length - 3)) THEN
X        RETURN (0);
X    ENDIF;
X
X    LOOP
X
X        EXITIF nextwin = 0;
X
X        IF (GET_INFO (nextwin, "BUFFER") <> 0) THEN
X            nexttop := GET_INFO (nextwin, "VISIBLE_TOP");
X
X            IF (winbot + 2 = nexttop) THEN
X                RETURN (nextwin);
X            ENDIF;
X        ENDIF;
X
X        nextwin := GET_INFO (nextwin, "NEXT");
X    ENDLOOP;
X
X    RETURN (0);
X
XENDPROCEDURE;
X
X!
X!   Return the window that is above the current one, or ZERO if there is
X!   none.  Note the special case that occurs while MAKE_FULL_SCREEN is active.
X!
XPROCEDURE vi$prev_win (win)
X
X    LOCAL
X        max_len,    ! Maximum length of screen minus the
X                    ! command window, and message window.
X        wintop,
X        prevbot,
X        prevwin;
X
X    IF (vi$in_occlusion) THEN
X        RETURN(0);
X    ENDIF;
X
X    max_len := vi$scr_length - 1;
X    prevwin := GET_INFO (WINDOWS, "FIRST");
X    wintop := GET_INFO (win, "VISIBLE_TOP");
X
X    IF (max_len <= wintop) THEN
X        RETURN (0);
X    ENDIF;
X
X    IF (max_len - 1 = GET_INFO (win, "VISIBLE_BOTTOM")) AND (wintop = 1) THEN
X        RETURN (0);
X    ENDIF;
X
X    LOOP
X        EXITIF prevwin = 0;
X
X        IF (GET_INFO (prevwin, "BUFFER") <> 0) THEN
X            prevbot := GET_INFO (prevwin, "VISIBLE_BOTTOM");
X
X            IF (prevbot + 2 = wintop) THEN
X                RETURN (prevwin);
X            ENDIF;
X        ENDIF;
X
X        prevwin := GET_INFO (prevwin, "NEXT");
X    ENDLOOP;
X
X    RETURN (0);
X
XENDPROCEDURE;
X
X!
X!   Shrink the current window, lengthing the lower window if possible first.
X!   If there is no window below, then try above.  If can't do that either,
X!   then give up with a message
X!
XPROCEDURE vi$shrink_window (shrinkparm)
X
X    LOCAL
X        curwin,
X        currow,
X        prevwin,
X        nextwin,
X        newshrink;
X
X    IF (vi$in_occlusion) THEN
X        RETURN;
X    ENDIF;
X
X    newshrink := shrinkparm;
X
X    curwin := GET_INFO (WINDOWS, "CURRENT");
X    currow := GET_INFO (curwin, "VISIBLE_LENGTH");
X
X    IF (currow < 3) THEN
X        MESSAGE ("Can't shrink this window");
X        RETURN;
X    ENDIF;
X
X    IF newshrink > currow - 2 THEN
X        newshrink := currow - 2;
X    ENDIF;
X
X    IF newshrink <= 0 THEN
X        MESSAGE ("Can't shrink this window");
X        RETURN;
X    ENDIF;
X
X    nextwin := vi$next_win (curwin);
X    prevwin := vi$prev_win (curwin);
X
X    IF (nextwin <> 0) THEN
X        ADJUST_WINDOW (curwin, 0, -newshrink);
X        ADJUST_WINDOW (nextwin, -newshrink, 0);
X    ELSE
X        IF (prevwin <> 0) THEN
X            ADJUST_WINDOW (curwin, newshrink, 0);
X            ADJUST_WINDOW (prevwin, 0, newshrink);
X        ELSE
X            MESSAGE ("Can't shrink this window");
X            RETURN;
X        ENDIF;
X    ENDIF;
X    POSITION (curwin);
X    vi$pos_in_middle (MARK(NONE));
XENDPROCEDURE;
X
X!
X!   Enlarge the current window if possible.  Try moving the bottom down.
X!   If that doesn't work, then try moving the top up.
X!
XPROCEDURE vi$enlarge_window (enlargeparm)
X
X    LOCAL
X        curwin,
X        prevwin,
X        nextwin,
X        nextrow,
X        newenlarge,
X        prevrow;
X
X    IF (vi$in_occlusion) THEN
X        RETURN;
X    ENDIF;
X
X    newenlarge := enlargeparm;
X
X    curwin := GET_INFO (WINDOWS, "CURRENT");
X
X    nextwin := vi$next_win (curwin);
X    prevwin := vi$prev_win (curwin);
X
X    IF (nextwin <> 0) THEN
X        nextrow := GET_INFO (nextwin, "VISIBLE_LENGTH");
X
X        IF (nextrow > 2) then
X            IF (newenlarge + 2 > nextrow) THEN
X                newenlarge := nextrow - 2;
X            ENDIF;
X
X            IF newenlarge <= 0 THEN
X                MESSAGE ("Can't enlarge this window");
X                RETURN;
X            ENDIF;
X
X            ADJUST_WINDOW (nextwin, newenlarge, 0);
X            ADJUST_WINDOW (curwin, 0, newenlarge);
X        ELSE
X            MESSAGE ("Can't shrink next window");
X            RETURN;
X        ENDIF;
X    ELSE
X        IF (prevwin <> 0) THEN
X
X            prevrow := GET_INFO (prevwin, "VISIBLE_LENGTH");
X
X            IF (prevrow < 3) THEN
X                MESSAGE ("Can't shrink previous window");
X                RETURN;
X            ENDIF;
X
X            IF (newenlarge + 2 > prevrow) THEN
X                newenlarge := prevrow - 2;
X            ENDIF;
X
X            IF newenlarge = 0 THEN
X                MESSAGE ("Can't enlarge this window");
X                RETURN;
X            ENDIF;
X
X            ADJUST_WINDOW (prevwin, 0, -newenlarge);
X            ADJUST_WINDOW (curwin, -newenlarge, 0);
X        ELSE
X            MESSAGE ("Can't enlarge this window");
X            RETURN;
X        ENDIF;
X    ENDIF;
X
X    POSITION (curwin);
X    vi$pos_in_middle (MARK(NONE));
XENDPROCEDURE;
X
X!
X!   Set the status line for the window passed
X!
XPROCEDURE vi$set_status_line (win)
X    LOCAL
X        nowr,
X        buf,
X        fmtstr,
X        fn;
X
X    IF (GET_INFO (win, "STATUS_VIDEO") <> REVERSE) THEN
X        RETURN;
X    ENDIF;
X
X    buf := GET_INFO (win, "BUFFER");
X    nowr := " ";
X    IF (GET_INFO (buf, "NO_WRITE")) THEN
X        nowr := "*";
X    ENDIF;
X    fn := GET_INFO (buf, "NAME");
X    SET (STATUS_LINE, win, NONE, "");
X    fmtstr := "!" + STR (GET_INFO (win, "WIDTH"));
X    SET (STATUS_LINE, win, REVERSE,
X            FAO (fmtstr+"<!ASBuffer: !AS!>", nowr, fn));
XENDPROCEDURE;
X
X!
X!   Position the location passed into the middle of the current window.
X!
XPROCEDURE vi$pos_in_middle (pos)
X    LOCAL
X        scroll_top,
X        scroll_bottom,
X        cur_window,
X        scroll_amount,
X        scrl_value;
X
X    ON_ERROR
X    ENDON_ERROR;
X
X    cur_window    := CURRENT_WINDOW;
X    scrl_value    := (GET_INFO (cur_window, "VISIBLE_LENGTH") / 2);
X
X    POSITION (pos);
X    MOVE_VERTICAL (-scrl_value);
X    vi$update (cur_window);
X    POSITION (pos);
XENDPROCEDURE;
X
X!
X!   Update the status lines for windows with the buffer passed mapped to them
X!
XPROCEDURE vi$status_lines (buf)
X    LOCAL
X        win;
X
X    win := GET_INFO (WINDOWS, "FIRST");
X    LOOP
X        EXITIF (win = 0);
X        IF (GET_INFO (win, "BUFFER") = buf) THEN
X            vi$set_status_line (win);
X        ENDIF;
X        win := GET_INFO (WINDOWS, "NEXT");
X    ENDLOOP;
XENDPROCEDURE;
X
X!
X!   Send the string passed to a DCL process.  All the necessary stuff is
X!   done to move to the DCL buffer, and start the DCL process, and all
X!   of the other junk.
X!
XPROCEDURE vi$send_to_dcl (dcl_string)
X
X    ON_ERROR
X        IF ERROR = TPU$_CREATEFAIL THEN
X            MESSAGE ("DCL subprocess could not be created");
X            RETURN (1);
X        ENDIF;
X    ENDON_ERROR;
X
X    IF CURRENT_BUFFER <> vi$dcl_buf THEN
X
X        IF (GET_INFO (vi$dcl_buf, "MAP_COUNT") > 0) AND
X                (vi$in_occlusion = 0) THEN
X            POSITION (vi$dcl_buf);
X        ELSE
X
X            ! Attempt to split the screen at the cursor position
X
X            IF (vi$split_here = 1) THEN
X                IF (vi$in_occlusion = 0) THEN
X                    MESSAGE ("Move cursor to middle of current window");
X                ENDIF;
X                RETURN (1);
X            ENDIF;
X
X            MAP (CURRENT_WINDOW, vi$dcl_buf);
X        ENDIF;
X    ENDIF;
X
X    POSITION (END_OF (vi$dcl_buf));
X    vi$status_lines (CURRENT_BUFFER);
X    UPDATE (CURRENT_WINDOW);
X
X    IF (GET_INFO (vi$dcl_process, "TYPE") = UNSPECIFIED) OR
X                                               (vi$dcl_process = 0) THEN
X        MESSAGE ("Creating DCL subprocess...");
X        vi$dcl_process := CREATE_PROCESS (vi$dcl_buf);
X        IF (vi$dcl_process = 0) THEN
X            RETURN;
X        ENDIF;
X        MESSAGE ("Process was created");
X    ENDIF;
X
X    SPLIT_LINE;
X    COPY_TEXT (dcl_string);
X    UPDATE (CURRENT_WINDOW);
X    SEND (dcl_string, vi$dcl_process);
X    POSITION (END_OF (vi$dcl_buf));
X    UPDATE (CURRENT_WINDOW);
X
X    RETURN (0);
XENDPROCEDURE;
X
X!
X!
X!
XPROCEDURE vi$mess_select (mode)
X    LOCAL
X        pos;
X
X    pos := MARK (NONE);
X    vi$message_select := 0;
X    POSITION (END_OF (message_buffer));
X    vi$message_select := SELECT (mode);
X    POSITION (pos);
XENDPROCEDURE;
X
X!
X!  Allow local modifications to be done here.
X!
XPROCEDURE tpu$local_init
XENDPROCEDURE;
X
X!
X!   Create a section file, and terminate.
X!
Xvi$init_keys;
XCOMPILE ("PROCEDURE vi$init_keys ENDPROCEDURE;");
XSAVE ("SYS$DISK:[]VI.GBL");
XQUIT;
$ GoSub Convert_File
$ Exit