gregg@a.cs.okstate.edu@mandrill.CWRU.Edu (Gregg Wonderly) (10/13/87)
$ 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$$