gregg@a.cs.okstate.edu (Gregg Wonderly) (09/28/88)
Posting-number: Volume 4, Issue 106
Submitted-by: "Gregg Wonderly" <gregg@a.cs.okstate.edu>
Archive-name: vms-vi-2/Part15
$ WRITE SYS$OUTPUT "Creating ""VI.11"""
$ CREATE VI.11
$ DECK/DOLLARS=$$EOD$$
copy_line,
orig_pos,
last_pos,
pos,
exitnow,
olen,
this_pos,
cur_tabs;
vi$start_pos := MARK (NONE);
pos := MARK (NONE);
nchar := vi$init_action (olen);
prog := vi$get_prog (nchar);
IF prog <> "" THEN
vi$do_movement (prog, VI$FILTER_TYPE);
IF (vi$endpos <> 0) THEN
POSITION (vi$endpos);
POSITION (LINE_BEGIN);
vi$endpos := MARK (NONE);
POSITION (vi$start_pos);
POSITION (LINE_BEGIN);
IF (MARK (NONE) = vi$endpos) THEN
MOVE_VERTICAL (1);
vi$endpos := MARK (NONE);
ENDIF;
POSITION (vi$endpos);
vi$move_horizontal (-1);
era_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);
MOVE_HORIZONTAL (1);
IF (era_range <> 0) THEN
vi$undo_end := 0;
POSITION (vi$start_pos);
vi$save_for_undo (era_range, VI$LINE_MODE, 1);
POSITION (vi$start_pos);
POSITION (LINE_BEGIN);
orig_pos := vi$get_undo_start;
IF (vi$filter_region (era_range, 0) = 0) THEN
vi$kill_undo;
vi$undo_end := 0;
POSITION (pos);
RETURN (vi$abort (0));
ENDIF;
IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
MOVE_HORIZONTAL (-1);
ENDIF;
vi$undo_end := MARK (NONE);
vi$undo_start := vi$set_undo_start (orig_pos);
vi$check_length (olen);
ELSE
vi$info ("Internal error while filtering!");
ENDIF;
ELSE
vi$abort (0);
ENDIF;
ELSE
vi$abort (0);
ENDIF;
ENDPROCEDURE;
!
! Filter the region of text indicated by "region", using the command
! given in cmd_parm.
!
PROCEDURE vi$filter_region (region, cmd_parm)
LOCAL
cmd;
ON_ERROR
vi$info ("ERROR filtering text!");
RETURN (0);
ENDON_ERROR;
cmd := cmd_parm;
IF (vi$filter_buf = 0) THEN
vi$filter_buf := vi$init_buffer ("$$filter_buffer$$", "");
IF (vi$filter_buf = 0) THEN
vi$info ("Can't create buffer, filter aborted!");
RETURN (0);
ENDIF;
ELSE
ERASE (vi$filter_buf);
ENDIF;
IF (cmd = 0) THEN
IF (vi$read_a_line ("!", cmd) = 0) THEN
RETURN (0);
ENDIF;
ENDIF;
vi$info_success_off;
IF (vi$filter_proc = 0) THEN
IF cmd = "!" THEN
cmd := vi$last_filter;
IF (cmd = 0) THEN
vi$info ("No previous command to use!");
RETURN (0);
ENDIF;
ELSE
vi$last_filter := cmd;
ENDIF;
vi$filter_proc := CREATE_PROCESS (vi$filter_buf, cmd);
IF (vi$filter_proc = 0) THEN
vi$info ("Can't create process, filter aborted!");
RETURN (0);
ENDIF;
ENDIF;
SEND (region, vi$filter_proc);
IF vi$filter_proc <> 0 THEN
DELETE (vi$filter_proc);
vi$filter_proc := 0;
ENDIF;
vi$info_success_on;
ERASE (region);
COPY_TEXT (vi$filter_buf);
RETURN (1);
ENDPROCEDURE;
!
! Shift the selected text region one SHIFT_WIDTH to the right.
!
PROCEDURE vi$region_right
vi$region_shift(1);
ENDPROCEDURE
!
! Shift the selected text region one SHIFT_WIDTH to the left.
!
PROCEDURE vi$region_left
vi$region_shift (0);
ENDPROCEDURE
!
! This function shifts the selected region right or left based on
! the mode passed.
!
! Parameters:
! mode 0 indicates a left shift, 1 indicates right.
!
PROCEDURE vi$region_shift (mode)
LOCAL
act_char,
needed,
era_range,
prog,
nchar,
copy_line,
tab_len,
oline,
nline,
state,
orig_pos,
last_pos,
exitnow,
this_pos,
cur_tabs;
ON_ERROR;
IF state <> 0 THEN
IF (ERROR = TPU$_ENDOFBUF) AND (state = 2) THEN
exitnow := 1;
ELSE
orig_pos := 0;
ENDIF;
ELSE
vi$info ("Error occured during shift, at line: "+
STR(ERROR_LINE));
POSITION (vi$start_pos);
RETURN;
ENDIF;
ENDON_ERROR;
vi$start_pos := MARK (NONE);
nchar := vi$init_action (state);
state := 0;
IF ((mode = 1) AND (ASCII (nchar) = '<')) OR
((mode = 0) AND (ASCII (nchar) = '>')) THEN
RETURN;
ENDIF;
prog := vi$get_prog (nchar);
IF prog <> "" THEN
vi$do_movement (prog, VI$SHIFT_TYPE);
oline := vi$cur_line_no;
IF (vi$endpos <> 0) THEN
POSITION (vi$endpos);
POSITION (LINE_BEGIN);
nline := vi$abs (vi$cur_line_no - oline);
vi$endpos := MARK (NONE);
POSITION (vi$start_pos);
POSITION (LINE_BEGIN);
IF (MARK (NONE) = vi$endpos) THEN
MOVE_VERTICAL (1);
vi$endpos := MARK (NONE);
ENDIF;
POSITION (vi$endpos);
vi$move_horizontal (-1);
era_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);
MOVE_HORIZONTAL (1);
IF (era_range <> 0) THEN
vi$undo_end := 0;
POSITION (vi$start_pos);
vi$save_for_undo (era_range, vi$yank_mode, 1);
POSITION (vi$start_pos);
POSITION (LINE_BEGIN);
orig_pos := vi$get_undo_start;
cur_tabs := GET_INFO (CURRENT_BUFFER, "TAB_STOPS");
IF (GET_INFO (cur_tabs, "TYPE") = STRING) THEN
vi$info ("Can't shift region with uneven tabstops.");
RETURN;
ELSE
tab_len := cur_tabs;
ENDIF;
state := 2;
exitnow := 0;
LOOP
EXITIF MARK (NONE) = vi$endpos;
EXITIF MARK (NONE) = END_OF (CURRENT_BUFFER);
EXITIF (exitnow = 1);
copy_line := vi$current_line;
IF (copy_line <> "") THEN
! Copy line is truncated to have no leading spaces.
needed := vi$vis_indent (copy_line, tab_len);
IF mode = 1 THEN
needed := needed + vi$shift_width;
ELSE
needed := needed - vi$shift_width;
ENDIF;
IF (needed < 0) THEN
needed := 0;
ENDIF;
ERASE_LINE;
COPY_TEXT (vi$get_tabs (needed, tab_len)+copy_line);
MOVE_HORIZONTAL (1);
IF (MARK (NONE) <> END_OF(CURRENT_BUFFER)) THEN
MOVE_HORIZONTAL (-1);
SPLIT_LINE;
ENDIF;
ELSE
MOVE_VERTICAL (1);
ENDIF;
POSITION (LINE_BEGIN);
ENDLOOP;
MOVE_HORIZONTAL (-1);
vi$undo_end := MARK (NONE);
vi$undo_start := vi$set_undo_start (orig_pos);
POSITION (vi$undo_start);
IF (nline >= vi$report) THEN
act_char := ">";
IF mode = 0 THEN
act_char := "<";
ENDIF;
vi$info (STR (nline) + " lines " + act_char + "'d");
ENDIF;
ELSE
vi$info ("Internal error while shifting!");
ENDIF;
ELSE
vi$abort (0);
ENDIF;
ELSE
vi$abort (0);
ENDIF;
ENDPROCEDURE;
!
! This procedure is called to calculate the number of spaces
! occupied on the screen by the leading white space of "line". "tabstops"
! holds the number of spaces a tab displays as obtained with a call to
! GET_INFO (CURRENT_BUFFER, "TAB_STOPS"). Line is stripped of the leading
! space on return, and the function returns the number of spaces occupied
! on the screen.
!
PROCEDURE vi$vis_indent (line, tabstops)
LOCAL
idx,
cur_ch,
cnt;
idx := 1;
cnt := 0;
LOOP
cur_ch := SUBSTR (line, idx, 1);
EXITIF (cur_ch = "");
EXITIF (INDEX (vi$_space_tab, cur_ch) = 0);
IF (cur_ch = " ") THEN
cnt := cnt + 1;
ELSE
cnt := cnt + (tabstops - (cnt - ((cnt / tabstops) * tabstops)));
ENDIF;
idx := idx + 1;
ENDLOOP;
! Truncate the line removing the leading whitespace.
line := SUBSTR (line, idx, LENGTH (line) - idx + 1);
RETURN (cnt);
ENDPROCEDURE;
!
! This procedure builds a string with as many tabs as possible to create
! the indentation level given by "len". "tabstops" is the number of spaces
! a tab produces on the screen.
!
PROCEDURE vi$get_tabs (len, tabstops)
LOCAL
tab_text,
rstr;
rstr := "";
! Select the proper tabbing text based on the setting of vi$use_tabs
tab_text := ASCII (9);
IF (vi$use_tabs = 0) THEN
tab_text := SUBSTR (vi$spaces, 1, tabstops);
ENDIF;
LOOP
EXITIF (len = 0);
IF (len >= tabstops) THEN
len := len - tabstops;
rstr := rstr + tab_text;
ELSE
rstr := rstr + SUBSTR (vi$spaces, 1, len);
len := 0;
ENDIF;
ENDLOOP;
RETURN (rstr);
ENDPROCEDURE;
!
! This function should be used to abort the current keyboard stream.
! It will assure that a macro does not continue to operate after a
! failure.
!
PROCEDURE vi$abort (n)
vi$key_buf := 0;
RETURN (n);
ENDPROCEDURE;
!
! Decide what the current line number is.
!
PROCEDURE vi$cur_line_no
LOCAL
pos,
cnt,
val,
opos;
ON_ERROR
POSITION (pos);
IF (val > 1) THEN
val := val / 2;
cnt := cnt - val;
ELSE
POSITION (opos);
RETURN (cnt);
ENDIF;
ENDON_ERROR;
opos := MARK (NONE);
val := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT") * 2 / 3;
IF (val = 0) THEN
val := 1;
ENDIF;
cnt := 1;
LOOP
pos := MARK (NONE);
MOVE_VERTICAL (-val);
cnt := cnt + val;
ENDLOOP;
ENDPROCEDURE;
!
! Copy a buffer of keys for use later. This routine is used mostly to
! make a copy of the last series of keystrokes from repeating when '.'
! is typed.
!
PROCEDURE vi$copy_keys (to_keys, from_keys)
LOCAL
pos;
pos := MARK (NONE);
ERASE (to_keys);
POSITION (to_keys);
COPY_TEXT (from_keys);
POSITION (BEGINNING_OF (to_keys));
POSITION (pos);
ENDPROCEDURE;
!
! Convert a string of characters into a buffer of key strokes.
!
PROCEDURE vi$str_to_keybuf (tstring, tbuf)
LOCAL
pos,
idx;
idx := 1;
pos := MARK (NONE);
POSITION (BEGINNING_OF (tbuf));
! Note that a bug in TPU causes ill behavior if you try to ERASE
! a buffer that TPU has never written anything into.
SPLIT_LINE;
APPEND_LINE;
ERASE (tbuf);
LOOP
EXITIF idx > LENGTH (tstring);
COPY_TEXT (STR (INT (KEY_NAME (SUBSTR (tstring, idx, 1)))));
! Move to EOB so next COPY_TEXT will insert a new line.
MOVE_HORIZONTAL (1);
idx := idx + 1;
ENDLOOP;
! There must be 2 lines (the first should be blank) at the end of the
! buffer to make it appear exactly as a key mapping.
SPLIT_LINE;
SPLIT_LINE;
POSITION (pos);
ENDPROCEDURE;
!
! Save the key passed into the push back buffer.
!
PROCEDURE vi$push_a_key (ch)
LOCAL
pos;
pos := MARK (NONE);
POSITION (vi$cur_keys);
COPY_TEXT (STR (INT (ch)));
MOVE_HORIZONTAL (1);
POSITION (pos);
ENDPROCEDURE;
!
! Insert the buffer passed into the stream of key_board characters so
! that they act as a macro.
!
PROCEDURE vi$insert_macro_keys (key_buf)
LOCAL
spos,
pos;
IF vi$push_key_buf = 0 THEN
vi$push_key_buf := vi$init_buffer ("$$push_key_buf$$", "");
ENDIF;
pos := MARK (NONE);
IF (vi$key_buf <> 0) THEN
IF (vi$key_buf = vi$push_key_buf) THEN
POSITION (vi$push_key_buf);
MOVE_HORIZONTAL (-1);
spos := MARK (NONE);
MOVE_HORIZONTAL (1);
SET (INSERT, CURRENT_BUFFER);
COPY_TEXT (key_buf);
! Remove blank line at end, and possible DEFINE_KEY mapping.
MOVE_VERTICAL (-1);
ERASE_LINE;
MOVE_VERTICAL (-1);
ERASE_LINE;
POSITION (spos);
MOVE_HORIZONTAL (1);
ELSE
POSITION (vi$key_buf);
spos := MARK (NONE);
ERASE (vi$push_key_buf);
POSITION (vi$push_key_buf);
SET (INSERT, CURRENT_BUFFER);
COPY_TEXT (CREATE_RANGE (spos, END_OF (vi$key_buf), NONE));
! Remove blank line at end, and possible DEFINE_KEY mapping.
MOVE_VERTICAL (-1);
ERASE_LINE;
MOVE_VERTICAL (-1);
ERASE_LINE;
COPY_TEXT (key_buf);
POSITION (BEGINNING_OF (vi$push_key_buf));
vi$key_buf := vi$push_key_buf;
ENDIF;
ELSE
ERASE (vi$push_key_buf);
POSITION (vi$push_key_buf);
SET (INSERT, CURRENT_BUFFER);
COPY_TEXT (key_buf);
vi$key_buf := vi$push_key_buf;
POSITION (BEGINNING_OF (vi$push_key_buf));
ENDIF;
POSITION (pos);
ENDPROCEDURE;
!
! Erase a the last key pushed back.
!
PROCEDURE vi$del_a_key
LOCAL
pos;
pos := MARK (NONE);
POSITION (vi$cur_keys);
IF MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER) THEN
MOVE_VERTICAL (-1);
ERASE_LINE;
ENDIF;
POSITION (pos);
ENDPROCEDURE;
!
! Read a single keystroke from either the keyboard, or from the push
! back buffer if it is non-zero.
!
PROCEDURE vi$read_a_key
LOCAL
read_a_key,
pos,
ch;
read_a_key := 0;
! If there are no keys pushed, then read the keyboard.
IF (vi$key_buf = 0) OR (GET_INFO (vi$key_buf, "TYPE") <> BUFFER) THEN
read_a_key := 1;
vi$m_level := 0;
IF vi$term_vt200 THEN
ch := READ_KEY;
ELSE
ch := READ_CHAR;
ENDIF;
ELSE
! Otherwise extract the next key from the buffer.
pos := MARK (NONE);
POSITION (vi$key_buf);
! Get the key code.
ch := INT (vi$current_line);
MOVE_VERTICAL (1);
! Check for the end of the buffer.
IF (LENGTH (vi$current_line) = 0) THEN
vi$key_buf := 0;
ENDIF;
POSITION (pos);
ENDIF;
! If we are not running on a VT200, then do some key translations
IF NOT vi$term_vt200 THEN
IF ch = ASCII(27) THEN
ch := F11;
ENDIF;
ENDIF;
ch := KEY_NAME (ch);
! If a key was read from the keyboard, then push it back.
IF read_a_key THEN
vi$push_a_key (ch);
ENDIF;
! Save the last key read.
vi$last_key := ch;
! Return the keycode of the character
RETURN (ch);
ENDPROCEDURE;
!
! Turn pasthru on, on the terminal
!
PROCEDURE vi$pasthru_on
LOCAL
junk;
junk := CALL_USER (vi$cu_pasthru_on, "");
ENDPROCEDURE;
!
! Turn pasthru off, on the terminal
!
PROCEDURE vi$pasthru_off
LOCAL
junk;
junk := CALL_USER (vi$cu_pasthru_off, "");
ENDPROCEDURE;
!
! Spawn with pasthru off
!
PROCEDURE vi$spawn (cmd)
LOCAL
junk;
vi$pasthru_off;
IF (cmd = 0) THEN
SPAWN;
ELSE
SPAWN (cmd);
ENDIF;
vi$pasthru_on;
ENDPROCEDURE
!
! Quit with pasthru off
!
PROCEDURE vi$quit
vi$pasthru_off;
QUIT;
vi$pasthru_on;
ENDPROCEDURE
!
! Perform read_line with pasthru off
!
PROCEDURE vi$read_line (prompt)
LOCAL
junk;
vi$pasthru_off;
junk := READ_LINE (prompt);
vi$pasthru_on;
RETURN (junk);
ENDPROCEDURE;
!
! Initialize things by creating buffers and windows and perform other
! assorted operations.
!
PROCEDURE tpu$init_procedure
LOCAL
journal_file,
default_journal_name,
aux_journal_name,
cnt,
input_file;
! Flag to indicate status of editor during startup.
vi$starting_up := 1;
vi$readonly := 0;
IF (GET_INFO (COMMAND_LINE, "READ_ONLY") = 1) THEN
vi$readonly := 1;
ENDIF;
vi$info_success_off;
SET (MESSAGE_FLAGS, 1);
SET (BELL, BROADCAST, ON);
! Set the variables to their initial values.
vi$init_vars;
! Get some other information.
vi$term_vt200 := GET_INFO (SCREEN, "vt200");
vi$scr_width := GET_INFO (SCREEN, "WIDTH");
vi$scr_length := GET_INFO (SCREEN, "VISIBLE_LENGTH");
! Create the message buffer and window.
message_buffer := vi$init_buffer ("Messages", "");
message_window := CREATE_WINDOW (vi$scr_length - 1, 2, ON);
MAP (message_window, message_buffer);
SET (STATUS_LINE, message_window, NONE, "");
SET (MAX_LINES, message_buffer, 500);
ADJUST_WINDOW (message_window, 1, 0);
vi$mess_select (REVERSE);
! Command prompt area.
command_buffer := vi$init_buffer ("Commands", "");
command_window := CREATE_WINDOW (vi$scr_length, 1, OFF);
! Buffer for SHOW (xxx) stuff.
show_buffer := vi$init_buffer ("Show", "");
info_window := CREATE_WINDOW (1, vi$scr_length - 1, ON);
SET (STATUS_LINE, info_window, NONE, "");
! A buffer for the tags file(s).
vi$tag_buf := vi$init_buffer ("Tags buffer", "");
vi$load_tags;
vi$dcl_buf := vi$init_buffer ("DCL buffer", "[End of DCL buffer]");
vi$info_success_off;
! A buffer and a window to start editing in.
main_buffer := CREATE_BUFFER ("Main");
main_window := CREATE_WINDOW (1, vi$scr_length - 1, ON);
SET (EOB_TEXT, main_buffer, "[EOB]");
SET (STATUS_LINE, main_window, NONE, "");
! A buffer for wild carding and such.
choice_buffer := vi$init_buffer ("Choices", "");
! A buffer for the list of files we are currently editing.
vi$file_names := vi$init_buffer ("file_names", "");
! Buffer to hold last text inserted into a buffer.
vi$last_insert := vi$init_buffer ("$$last_insert$$", "");
! Buffer to hold KEY_NAME values of last key sequence.
vi$cur_keys := vi$init_buffer ("$$current_keys$$", "");
! Buffer to hold keys to be performed when '.' is pressed.
vi$last_keys := vi$init_buffer ("$$last_keys$$", "");
! Get a buffer to hold yank and deletes that are not aimed at named
! buffers.
vi$temp_buf := vi$init_buffer ("$$temp_buffer$$", "");
! Set up some more stuff.
SET (PROMPT_AREA, vi$scr_length, 1, BOLD);
SET (JOURNALING, 7);
SET (FACILITY_NAME, "VI");
! Move to the initial buffer.
MAP (main_window, main_buffer);
POSITION (main_buffer);
! Get the filename to edit.
input_file := GET_INFO (COMMAND_LINE, "FILE_NAME");
IF input_file = "" THEN
IF (GET_INFO (COMMAND_LINE, "OUTPUT")) THEN
input_file := GET_INFO (COMMAND_LINE, "OUTPUT_FILE");
ENDIF;
ENDIF;
! If there is an input file, then get it for editing.
IF input_file <> "" THEN
cnt := vi$get_file (input_file);
ELSE
vi$bmode_main := vi$readonly;
ENDIF;
! Delete the unused main buffer if it is not used.
IF (CURRENT_BUFFER <> main_buffer) AND (main_buffer <> 0) THEN
DELETE (main_buffer);
ENDIF;
! Start journaling if requested.
IF (GET_INFO (COMMAND_LINE, "JOURNAL") = 1) THEN
aux_journal_name := GET_INFO (CURRENT_BUFFER, "FILE_NAME");
IF aux_journal_name = "" THEN
aux_journal_name := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE");
ENDIF;
IF aux_journal_name = 0 THEN
aux_journal_name := "";
ENDIF;
IF aux_journal_name = "" THEN
default_journal_name := "MAIN.TJL";
ELSE
default_journal_name := ".TJL";
ENDIF;
journal_file := GET_INFO (COMMAND_LINE, "JOURNAL_FILE");
journal_file := FILE_PARSE (journal_file, default_journal_name,
aux_journal_name);
JOURNAL_OPEN (journal_file);
ENDIF;
! Force undefined keystrokes ("all of them") to call vi$command_mode.
SET (UNDEFINED_KEY, "tpu$key_map_list",
COMPILE ("vi$command_mode (LAST_KEY)"));
SET (SELF_INSERT, "tpu$key_map_list", OFF);
vi$info_success_on;
! Change PF1 so that it is NOT a shift key.
SET (SHIFT_KEY, KEY_NAME (PF1, SHIFT_KEY));
! Do any user added local initialization.
tpu$local_init;
! Do the INI file.
IF FILE_SEARCH ("EXRC") = "" THEN
vi$do_file ("SYS$LOGIN:VI.INI", 0);
ELSE
vi$do_file ("EXRC", 0);
ENDIF;
vi$do_exinit;
! Enable passthru on the terminal so that ^Y does 'Push screen'.
vi$pasthru_on;
! Say we are no longer starting up.
vi$starting_up := 0;
ENDPROCEDURE;
!
! Process the EXINIT environment variable (Process Logical actually).
!
PROCEDURE vi$do_exinit
LOCAL
exinit;
ON_ERROR
RETURN;
ENDON_ERROR;
exinit := call_user (vi$cu_trnlnm_job, "EXINIT");
vi$do_cmd_line (exinit);
ENDPROCEDURE;
!
! Load the file given in fn, into a buffer and execute the contents as
! a series of EX mode commands. "complain" is boolean, and determines
! whether or not we complain about a non existant file.
!
PROCEDURE vi$do_file (rfn, complain)
LOCAL
fn,
ini_buffer,
ini_file;
fn := rfn;
ini_file := FILE_SEARCH ("");
fn := FILE_PARSE (fn);
ini_file := FILE_SEARCH (fn);
IF (ini_file = "") THEN
IF (complain) THEN
vi$info ("Can't find file """+fn+"""!");
ENDIF;
RETURN (1);
ENDIF;
vi$info_success_off;
ini_buffer := CREATE_BUFFER ("VI$CMD$INI$$", ini_file);
IF ini_buffer = 0 THEN
IF (complain) THEN
vi$info ("can't process file """+ini_file+"""!");
ENDIF;
vi$info_success_on;
RETURN(1);
ENDIF;
vi$process_buffer (ini_buffer);
DELETE (ini_buffer);
vi$info_success_on;
RETURN (1);
ENDPROCEDURE;
!
! Execute the contents of the passed buffer as EX mode commands
!
PROCEDURE vi$process_buffer (buffer_parm)
LOCAL
line,
old_pos,
cur_pos;
old_pos := MARK (NONE);
POSITION (BEGINNING_OF (buffer_parm));
LOOP
cur_pos := MARK (NONE);
EXITIF (cur_pos = END_OF (buffer_parm));
line := CURRENT_LINE;
IF (LENGTH (line) > 0) AND (SUBSTR (line, 1, 1) <> '!') THEN
POSITION (old_pos);
vi$do_cmd_line (line);
old_pos := MARK (NONE);
POSITION (cur_pos);
ENDIF;
MOVE_VERTICAL (1);
ENDLOOP;
POSITION (old_pos);
ENDPROCEDURE;
!
! Initialize a system/nowrite buffer.
!
PROCEDURE vi$init_buffer (new_buffer_name, new_eob_text)
LOCAL
new_buffer; ! New buffer
new_buffer := CREATE_BUFFER (new_buffer_name);
SET (EOB_TEXT, new_buffer, new_eob_text);
SET (NO_WRITE, new_buffer);
SET (SYSTEM, new_buffer);
RETURN (new_buffer);
ENDPROCEDURE;
!
! Expand the list of filenames given in "get_file_list" and return
! the count of names found as the function value. The file names will
! be in the vi$file_names buffer, one per line.
!
PROCEDURE vi$expand_file_list (get_file_list)
LOCAL
num_names,
fres,
fn,
fl,
comma_pos,
pos;
fl := get_file_list;
ERASE (choice_buffer);
IF (vi$file_names = 0) THEN
vi$file_names := vi$init_buffer ("file_names", "");
ELSE
ERASE (vi$file_names);
ENDIF;
! Expand the wild cards. Note that this also eliminates non-existant
! files from the list of files to edit.
LOOP
! Protect against earlier file_search.
fres := FILE_SEARCH ("");
EXITIF fl = "";
comma_pos := INDEX (fl, ",");
IF (comma_pos > 0) THEN
fn := SUBSTR (fl, 1, comma_pos - 1);
fl := SUBSTR (fl, comma_pos + 1, LENGTH (fl) - comma_pos);
ELSE
fn := fl;
fl := "";
ENDIF;
LOOP
fres := FILE_SEARCH (fn);
EXITIF fres = "";
vi$add_choice (fres);
ENDLOOP;
ENDLOOP;
! Save current position.
pos := MARK (NONE);
! Save a copy of the filenames list
POSITION (vi$file_names);
COPY_TEXT (choice_buffer);
POSITION (BEGINNING_OF (vi$file_names));
! Move back to where we were.
POSITION (pos);
! Save the count of file names.
num_names := GET_INFO (choice_buffer, "RECORD_COUNT");
RETURN (num_names);
ENDPROCEDURE;
!
! Put a file in the current window. If the file is already in a buffer,
! use the old buffer. If not, create a new buffer.
!
! Parameters:
!
! file_parameter String containing file name - input
!
PROCEDURE vi$get_file (file_parameter)
LOCAL
pos,
obuf,
get_file_parm,
outfile,
filename,
file_read,
get_file_name, ! Local copy of get_file_parameter
get_file_list, ! Possible comma separated list
temp_buffer_name, ! String for buffer name based on get_file_name
file_search_result, ! Latest string returned by file_search
temp_file_name, ! First file name string returned by file_search
loop_cnt, ! Number of files left to process in loop
file_cnt, ! Actual number of files found with FILE_SEARCH
loop_buffer, ! Buffer currently being checked in loop
new_buffer, ! New buffer created if needed
found_a_buffer, ! True if buffer found with same name
want_new_buffer; ! True if file should go into a new buffer
ON_ERROR
IF ERROR = TPU$_PARSEFAIL THEN
vi$info (FAO ("Don't understand file name: !AS", get_file_name));
RETURN (0);
ENDIF;
ENDON_ERROR;
obuf := CURRENT_BUFFER;
get_file_parm := file_parameter;
IF (get_file_parm = 0) OR (get_file_parm = "") THEN
vi$info ("File name must be supplied!");
RETURN (0);
ENDIF;
get_file_list := get_file_parm;
get_file_name := get_file_parm;
temp_file_name := 0;
loop_cnt := vi$expand_file_list (get_file_list);
! If none were found, then set up to enter the loop and get a new buffer
IF (loop_cnt = 0) THEN
loop_cnt := 1;
POSITION (BEGINNING_OF (choice_buffer));
ELSE
IF loop_cnt > 1 THEN
vi$info (FAO ("!UL files to edit!", loop_cnt));
ENDIF;
POSITION (BEGINNING_OF (choice_buffer));
temp_file_name := vi$current_line;
ERASE_LINE;
ENDIF;
file_cnt := loop_cnt;
LOOP
IF (GET_INFO (obuf, "TYPE") = BUFFER) THEN
POSITION (obuf);
ENDIF;
! See if we already have a buffer by that name
IF temp_file_name = 0 THEN
temp_buffer_name :=
FILE_PARSE (get_file_name, "", "", NAME) +
FILE_PARSE (get_file_name, "", "", TYPE);
ELSE
temp_buffer_name :=
FILE_PARSE (temp_file_name, "", "", NAME) +
FILE_PARSE (temp_file_name, "", "", TYPE);
ENDIF;
IF get_file_parm <> 0 THEN
! Trim the trailing dot off.
EDIT (get_file_parm, UPPER, COLLAPSE);
IF (SUBSTR (get_file_parm, LENGTH(get_file_parm), 1)
<> '.') THEN
IF (SUBSTR (temp_buffer_name,
LENGTH(temp_buffer_name), 1) = '.') THEN
temp_buffer_name :=
SUBSTR (temp_buffer_name, 1,
LENGTH(temp_buffer_name)-1);
ENDIF;
ENDIF;
ENDIF;
loop_buffer := GET_INFO (BUFFERS, "FIRST");
found_a_buffer := 0;
LOOP
EXITIF loop_buffer = 0;
IF temp_buffer_name = GET_INFO (loop_buffer, "NAME") THEN
found_a_buffer := 1;
EXITIF 1;
ENDIF;
loop_buffer := GET_INFO (BUFFERS, "NEXT");
ENDLOOP;
! If there is a buffer by that name, is it the same file?
! We ignore version numbers to keep our sanity
IF found_a_buffer THEN ! Have a buffer with the same name
IF temp_file_name = 0 THEN ! No file on disk
IF get_file_name = GET_INFO (loop_buffer, "OUTPUT_FILE") THEN
want_new_buffer := 0;
ELSE
! If the buffer is empty, then throw it
! away.
IF (GET_INFO (loop_buffer, "RECORD_COUNT") > 0) THEN
want_new_buffer := 0;
ELSE
IF (temp_file_name <> 0) and (temp_file_name <> "") THEN
vi$info ("Buffer empty, reading file");
POSITION (loop_buffer);
vi$info (FAO ('Reading "!AS"', temp_file_name));
file_read := READ_FILE (temp_file_name);
IF file_read <> "" THEN
SET (OUTPUT_FILE, loop_buffer, file_read);
vi$status_lines (loop_buffer);
ENDIF;
ENDIF;
want_new_buffer := 2;
POSITION (BEGINNING_OF (loop_buffer));
MAP (CURRENT_WINDOW, loop_buffer);
obuf := loop_buffer;
ENDIF;
ENDIF;
ELSE
! Check to see if the same file
outfile := GET_INFO (loop_buffer, "OUTPUT_FILE");
filename := GET_INFO (loop_buffer, "FILE_NAME");
! Trim version numbers off all of the names.
IF (outfile <> 0) THEN
outfile := FILE_PARSE (outfile, "", "", DEVICE) +
FILE_PARSE (outfile, "", "", DIRECTORY) +
FILE_PARSE (outfile, "", "", NAME) +
FILE_PARSE (outfile, "", "", TYPE);
ENDIF;
IF (filename <> 0) THEN
filename := FILE_PARSE (filename, "", "", DEVICE) +
FILE_PARSE (filename, "", "", DIRECTORY) +
FILE_PARSE (filename, "", "", NAME) +
FILE_PARSE (filename, "", "", TYPE);
ENDIF;
temp_file_name := FILE_PARSE (temp_file_name, "", "", DEVICE) +
FILE_PARSE (temp_file_name, "", "", DIRECTORY) +
FILE_PARSE (temp_file_name, "", "", NAME) +
FILE_PARSE (temp_file_name, "", "", TYPE);
! If the buffer is empty, then throw it away.
IF (GET_INFO (loop_buffer, "RECORD_COUNT") > 0) THEN
IF (outfile = temp_file_name) OR
(filename = temp_file_name) THEN
want_new_buffer := 0;
ELSE
want_new_buffer := 1;
ENDIF;
ELSE
IF temp_file_name <> 0 THEN
vi$info ("Buffer empty, reading file");
POSITION (loop_buffer);
vi$info (FAO ('Reading "!AS"', temp_file_name));
file_read := READ_FILE (temp_file_name);
IF (file_read <> "") THEN
SET (OUTPUT_FILE, loop_buffer, file_read);
vi$status_lines (loop_buffer);
ENDIF;
ENDIF;
want_new_buffer := 2;
POSITION (BEGINNING_OF (loop_buffer));
MAP (CURRENT_WINDOW, loop_buffer);
obuf := loop_buffer;
ENDIF;
ENDIF;
IF want_new_buffer = 1 THEN
vi$info (FAO (
"Buffer name !AS is in use", temp_buffer_name));
temp_buffer_name :=
vi$read_line (
"Type new buffer name or press Return to cancel: ");
IF temp_buffer_name = "" THEN
vi$info ("No new buffer created");
ELSE
new_buffer := vi$_create_buffer (temp_buffer_name,
get_file_name, temp_file_name);
ENDIF;
ELSE
IF (want_new_buffer = 0) and (CURRENT_BUFFER = loop_buffer) THEN
vi$info (FAO (
"Already editing file !AS", get_file_name));
ELSE
IF (want_new_buffer = 0) THEN
IF (vi$check_auto_write) THEN
RETURN;
ENDIF;
MAP (CURRENT_WINDOW, loop_buffer);
obuf := loop_buffer;
ENDIF;
ENDIF;
ENDIF;
ELSE ! No buffer with the same name, so create a new buffer
new_buffer := vi$_create_buffer (temp_buffer_name, get_file_name,
temp_file_name);
ENDIF;
IF new_buffer <> 0 THEN
SET (EOB_TEXT, new_buffer, "[EOB]");
SET (TAB_STOPS, new_buffer, vi$tab_amount);
ENDIF;
loop_cnt := loop_cnt - 1;
EXITIF loop_cnt <= 0;
POSITION (BEGINNING_OF (choice_buffer));
temp_file_name := vi$current_line;
ERASE_LINE;
ENDLOOP;
IF (file_cnt > 1) THEN
vi$_first_file (0);
ENDIF;
vi$set_status_line (CURRENT_WINDOW);
RETURN (file_cnt);
ENDPROCEDURE;
!
! This procedure collects the names of all buffers that are leading
! derivatives of "buffer_name". The function value is the boolean
! value telling whether or not the name matched exactly. The other
! parameters are return values.
!
PROCEDURE vi$choose_buffer (buffer_name, how_many_buffers,
possible_buffer, possible_buffer_name, loop_buffer)
LOCAL
this_buffer, ! Current buffer
loop_buffer_name, ! String containing name of loop_buffer
found_a_buffer; ! True if buffer found with same exact name
found_a_buffer := 0;
EDIT (buffer_name, COLLAPSE);
possible_buffer := 0;
possible_buffer_name := 0;
how_many_buffers := 0;
! See if we already have a buffer by that name
this_buffer := CURRENT_BUFFER;
loop_buffer := GET_INFO (BUFFERS, "FIRST");
CHANGE_CASE (buffer_name, UPPER); ! buffer names are uppercase
ERASE (choice_buffer);
LOOP
EXITIF loop_buffer = 0;
loop_buffer_name := GET_INFO (loop_buffer, "NAME");
IF buffer_name = loop_buffer_name THEN
found_a_buffer := 1;
how_many_buffers := 1;
EXITIF 1;
ELSE
IF buffer_name = SUBSTR (loop_buffer_name, 1,
LENGTH (buffer_name)) THEN
vi$add_choice (loop_buffer_name);
possible_buffer := loop_buffer;
possible_buffer_name := loop_buffer_name;
how_many_buffers := how_many_buffers + 1;
ENDIF;
ENDIF;
loop_buffer := GET_INFO (BUFFERS, "NEXT");
ENDLOOP;
RETURN (found_a_buffer);
ENDPROCEDURE;
!
! Return current line or empty string if at EOB
!
PROCEDURE vi$current_line
IF (MARK (NONE) = END_OF (CURRENT_BUFFER)) THEN
RETURN ("");
ELSE
RETURN (CURRENT_LINE);
ENDIF;
ENDPROCEDURE;
!
! If autowrite is active, then write the current buffer out.
!
PROCEDURE vi$check_auto_write
LOCAL
buf,
win,
owin,
mod;
mod := GET_INFO (CURRENT_BUFFER, "MODIFIED") AND
(NOT GET_INFO (CURRENT_BUFFER, "SYSTEM")) AND
(NOT GET_INFO (CURRENT_BUFFER, "NO_WRITE"));
buf := CURRENT_BUFFER;
IF mod AND vi$auto_write THEN
IF (vi$can_write (CURRENT_BUFFER)) THEN
vi$info ("Writing out """+GET_INFO (buf, "NAME")+"""");
WRITE_FILE (buf);
ELSE
RETURN (1);
ENDIF;
ENDIF;
IF (NOT mod) AND
(NOT GET_INFO (CURRENT_BUFFER, "SYSTEM")) AND
(NOT GET_INFO (CURRENT_BUFFER, "NO_WRITE")) AND
(GET_INFO (buf, "RECORD_COUNT") = 0) THEN
IF (vi$delete_empty) THEN
vi$info ("Deleting empty buffer: "+GET_INFO (buf, "NAME"));
MAP (CURRENT_WINDOW, message_buffer);
owin := CURRENT_WINDOW;
win := GET_INFO (WINDOWS, "FIRST");
LOOP
EXITIF win = 0;
IF (GET_INFO (win, "BUFFER") = buf) THEN
MAP (win, message_buffer);
vi$set_status_line (win);
ENDIF;
win := GET_INFO (WINDOWS, "NEXT");
ENDLOOP;
POSITION (owin);
DELETE (buf);
ELSE
vi$last_mapped := buf;
ENDIF;
ELSE
vi$last_mapped := buf;
ENDIF;
RETURN (0);
ENDPROCEDURE;
!
! Only perform an update if there is not a keyboard macro in progress.
!
PROCEDURE vi$update (win)
IF (vi$key_buf = 0) AND (vi$playing_back = 0) THEN
UPDATE (win);
ENDIF;
ENDPROCEDURE;
!
! This procedure should be envoked after a wild card edit. It will allow
! a list of files that have been created due to a wildcard filespec to be
! processed sequentially.
!
PROCEDURE vi$_next_file (bang)
LOCAL
win,
fn,
pos,
found_one,
btype,
bn,
how_many_buffers,
possible_buffer,
possible_buffer_name,
loop_buffer,
line;
ON_ERROR
! Ignore errors
ENDON_ERROR;
IF (NOT bang) AND (vi$check_auto_write) THEN
RETURN;
ENDIF;
pos := MARK (NONE);
win := CURRENT_WINDOW;
POSITION (vi$file_names);
IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
MOVE_VERTICAL (1);
IF (MARK (NONE) = END_OF (CURRENT_BUFFER)) THEN
vi$info ("No more files!");
MOVE_VERTICAL (-1);
POSITION (win);
RETURN (1);
ENDIF;
ELSE
vi$info ("No more files!");
POSITION (win);
RETURN (1);
ENDIF;
fn := vi$current_line;
bn := FILE_PARSE (fn, "", "", NAME);
btype := FILE_PARSE (fn, "", "", TYPE);
IF btype = "" THEN
btype := ".";
$$EOD$$