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:46:21.73
$!
$! It contains the following 1 file:
$! VI.10
$!=============================================================================
$ 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.10"
$ Check_Sum_is=1786123033
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X IF (direction = -1) THEN
X LOOP
X EXITIF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER));
X MOVE_HORIZONTAL (-1);
X EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE);
X ENDLOOP;
X ENDIF;
X
X LOOP
X EXITIF ((MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) AND
X (direction = -1));
X EXITIF ((MARK (NONE) = END_OF (CURRENT_BUFFER)) AND
X (direction = 1));
X EXITIF (CURRENT_CHARACTER = "");
X EXITIF vi$get_type (CURRENT_CHARACTER) = VI$SPACE_TYPE;
X MOVE_HORIZONTAL (direction);
X ENDLOOP;
X
X ! A hack to make change work like it is supposed to with "cw".
X
X IF (vi$command_type = VI$CHANGE_TYPE) AND (direction = 1) THEN
X vi$new_endpos := MARK (NONE);
X ENDIF;
X
X IF (direction = 1) THEN
X LOOP
X EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
X EXITIF (CURRENT_CHARACTER = "");
X MOVE_HORIZONTAL (1);
X EXITIF vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE;
X ENDLOOP;
X ELSE
X IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
X MOVE_HORIZONTAL (1);
X ENDIF;
X ENDIF;
X
X RETURN (vi$retpos(pos));
XENDPROCEDURE;
X
X!
X! Move the cursor by logical words. Note that words in this case are
X! delimited by a change from one type of character to another. The
X! predefined types
X!
X! VI$ALPHA_TYPE, VI$PUNCT_TYPE, and VI$SPACE_TYPE
X!
X! are used to detect transitions from one word to the next;
X!
XPROCEDURE vi$move_logical_word (direction)
X
X LOCAL
X this_type,
X this_char,
X pos;
X
X pos := MARK (NONE);
X
X ! If direction is back, then skip SPACE characters until no space
X ! is found.
X
X IF (direction = -1) THEN
X LOOP
X EXITIF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER));
X MOVE_HORIZONTAL (-1);
X EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE);
X ENDLOOP;
X ENDIF;
X
X this_char := CURRENT_CHARACTER;
X this_type := vi$get_type (this_char);
X
X LOOP
X EXITIF ((MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) AND
X (direction = -1));
X
X EXITIF ((MARK (NONE) = END_OF (CURRENT_BUFFER)) AND
X (direction = 1));
X
X MOVE_HORIZONTAL (direction);
X EXITIF (vi$get_type (CURRENT_CHARACTER) <> this_type);
X ENDLOOP;
X
X ! A hack to make change work like it is supposed to with "cw".
X
X IF (vi$command_type = VI$CHANGE_TYPE) AND (direction = 1) THEN
X vi$new_endpos := MARK (NONE);
X ENDIF;
X
X IF (direction = 1) THEN
X LOOP
X EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE);
X MOVE_HORIZONTAL (1);
X EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
X ENDLOOP;
X ELSE
X IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
X MOVE_HORIZONTAL (1);
X ENDIF;
X ENDIF;
X
X RETURN (vi$retpos (pos));
X
XENDPROCEDURE;
X
X!
X! Move the cursor by BLANK separated words. DIRECTION is either
X! +1, or -1 to indicate the direction (forward, or backword respectfully)
X! to move
X!
XPROCEDURE vi$move_full_end
X
X LOCAL
X pos;
X
X pos := MARK (NONE);
X
X MOVE_HORIZONTAL (1);
X LOOP
X EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
X EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE);
X MOVE_HORIZONTAL (1);
X ENDLOOP;
X
X LOOP
X EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
X EXITIF (vi$get_type (CURRENT_CHARACTER) = VI$SPACE_TYPE);
X MOVE_HORIZONTAL (1);
X ENDLOOP;
X
X MOVE_HORIZONTAL (-1);
X RETURN (vi$retpos(pos));
XENDPROCEDURE;
X
X!
X! Move the cursor by logical words. Note that words in this case are
X! delimited by a change from one type of character to another. The
X! predefined types
X!
X! VI$ALPHA_TYPE, VI$PUNCT_TYPE, and VI$SPACE_TYPE
X!
X! are used to detect transitions from one word to the next;
X!
XPROCEDURE vi$move_logical_end
X
X LOCAL
X this_type,
X this_char,
X pos;
X
X pos := MARK (NONE);
X
X MOVE_HORIZONTAL (1);
X LOOP
X EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
X EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE);
X MOVE_HORIZONTAL (1);
X ENDLOOP;
X
X this_char := CURRENT_CHARACTER;
X this_type := vi$get_type (this_char);
X
X LOOP
X EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
X EXITIF (vi$get_type (CURRENT_CHARACTER) <> this_type);
X MOVE_HORIZONTAL (1);
X ENDLOOP;
X
X MOVE_HORIZONTAL (-1);
X RETURN (vi$retpos (pos));
XENDPROCEDURE;
X
X!
X! Return the logical type of the character passed. This is typically used
X! by the move_by_word routines to determine when a word ends.
X!
XPROCEDURE vi$get_type (this_char)
X
X LOCAL
X this_type;
X
X IF (this_char = "") THEN
X RETURN (VI$EOL_TYPE);
X ENDIF;
X
X this_type := VI$SPACE_TYPE;
X
X IF (INDEX (vi$_alpha_chars, this_char) <> 0) THEN
X this_type := VI$ALPHA_TYPE;
X ELSE
X IF (INDEX (vi$_punct_chars, this_char) <> 0) THEN
X this_type := VI$PUNCT_TYPE;
X ENDIF;
X ENDIF;
X
X RETURN (this_type);
XENDPROCEDURE;
X
X!
X! This procedure determines what line the cursor is currently positioned
X! on. and then prints that information, along with other items of interest
X! in the message window.
X!
XPROCEDURE vi$what_line
X
X LOCAL
X percent,
X mod,
X outfile,
X lines,
X nowr,
X pos,
X cnt;
X
X ON_ERROR;
X lines := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
X IF (cnt) > lines THEN
X cnt := lines;
X ENDIF;
X
X IF lines = 0 THEN
X percent := 0;
X ELSE
X percent := (cnt*100)/lines;
X ENDIF;
X
X vi$message (FAO ("!ASLine !UL of !UL, !UL%, !AS!AS",
X nowr, cnt, lines, percent, mod, outfile));
X
X SET (TIMER, OFF);
X RETURN;
X ENDON_ERROR;
X
X nowr := " ";
X IF (GET_INFO (CURRENT_BUFFER, "NO_WRITE")) THEN
X nowr := "*";
X ENDIF;
X
X mod := "";
X IF GET_INFO (CURRENT_BUFFER, "MODIFIED") THEN
X mod := "[modified] ";
X ENDIF;
X
X pos := MARK(NONE);
X MOVE_HORIZONTAL (- CURRENT_OFFSET);
X
X cnt := 0;
X lines := 0;
X outfile := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE");
X IF (outfile = 0) THEN
X outfile := "Not Edited";
X ELSE
X outfile := """"+outfile+"""";
X ENDIF;
X
X cnt := vi$cur_line_no;
X
X POSITION (pos);
X
X lines := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
X IF (cnt) > lines THEN
X cnt := lines;
X ENDIF;
X
X IF lines = 0 THEN
X percent := 0;
X ELSE
X percent := (cnt*100)/lines;
X ENDIF;
X
X vi$message (FAO ("!ASLine !UL of !UL, !UL%, !AS!AS",
X nowr, cnt, lines, percent, mod, outfile));
X SET (TIMER, OFF);
XENDPROCEDURE;
X
X!
X! This function moves to "pos" if it is non-zero. If "pos" is zero, then
X! any current macro is aborted, and the current position is not changed.
X! "save_pos" is a boolean value that indicates whether or not the current
X! location is remembered so that it can be returned to later with the
X! "'" (go to marker) command.
X!
XPROCEDURE vi$position (pos, save_pos)
X IF (pos <> 0) THEN
X IF save_pos THEN
X vi$old_place := MARK (NONE);
X ENDIF;
X POSITION (pos);
X ELSE
X RETURN (vi$abort (0));
X ENDIF;
X RETURN (pos);
XENDPROCEDURE;
X
X!
X! This function implements the command mode function of joining the
X! current line with the one below it.
X!
X! The undo operation consists of deleting the line created by joining
X! the two lines, and then inserting the original contents of the two
X! joined lines.
X!
XPROCEDURE vi$_join_lines
X
X LOCAL
X start,
X end,
X spos,
X epos,
X pos,
X plen,
X len;
X
X ON_ERROR
X ! Throw away moved beyond end of buffer messages.
X RETURN;
X ENDON_ERROR;
X
X spos := MARK (NONE);
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X pos := MARK (NONE);
X IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
X MOVE_VERTICAL (1);
X IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
X MOVE_VERTICAL (1);
X MOVE_HORIZONTAL (-1);
X epos := MARK (NONE);
X POSITION (spos);
X vi$save_for_undo (CREATE_RANGE (pos, epos, NONE),
X VI$LINE_MODE, 1);
X POSITION (pos);
X ELSE
X RETURN;
X ENDIF;
X ELSE
X RETURN;
X ENDIF;
X
X MOVE_HORIZONTAL (LENGTH (vi$current_line));
X
X LOOP
X EXITIF (CURRENT_OFFSET = 0);
X MOVE_HORIZONTAL (-1);
X EXITIF INDEX (" ", CURRENT_CHARACTER) = 0;
X ERASE_CHARACTER (1);
X ENDLOOP;
X
X plen := LENGTH (vi$current_line);
X vi$_next_line;
X
X IF (CURRENT_OFFSET > 0) AND (plen > 0) THEN
X ERASE_CHARACTER (-CURRENT_OFFSET);
X ENDIF;
X
X len := LENGTH (vi$current_line);
X APPEND_LINE;
X
X IF (len > 0) AND (plen > 0) THEN
X COPY_TEXT (" ");
X MOVE_HORIZONTAL (-1);
X ELSE
X vi$check_rmarg;
X ENDIF;
X
X pos := MARK (NONE);
X
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X vi$undo_start := MARK (NONE);
X MOVE_HORIZONTAL (LENGTH (vi$current_line));
X vi$undo_end := MARK (NONE);
X
X POSITION (pos);
XENDPROCEDURE;
X
X!
X! This function filters the selected region through the command
X! given.
X!
XPROCEDURE vi$region_filter
X
X LOCAL
X era_range,
X prog,
X nchar,
X copy_line,
X orig_pos,
X last_pos,
X pos,
X exitnow,
X olen,
X this_pos,
X cur_tabs;
X
X vi$message ("");
X
X vi$start_pos := MARK (NONE);
X pos := MARK (NONE);
X nchar := vi$init_action (olen);
X prog := vi$get_prog (nchar);
X
X IF prog <> "" THEN
X vi$do_movement (prog, VI$FILTER_TYPE);
X
X IF (vi$endpos <> 0) THEN
X POSITION (vi$endpos);
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X vi$endpos := MARK (NONE);
X POSITION (vi$start_pos);
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X
X IF (MARK (NONE) = vi$endpos) THEN
X MOVE_VERTICAL (1);
X vi$endpos := MARK (NONE);
X ENDIF;
X
X POSITION (vi$endpos);
X
X vi$move_horizontal (-1);
X era_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);
X MOVE_HORIZONTAL (1);
X
X IF (era_range <> 0) THEN
X vi$undo_end := 0;
X POSITION (vi$start_pos);
X vi$save_for_undo (era_range, VI$LINE_MODE, 1);
X
X POSITION (vi$start_pos);
X MOVE_HORIZONTAL (- CURRENT_OFFSET);
X
X orig_pos := vi$get_undo_start;
X
X IF (vi$filter_region (era_range, 0) = 0) THEN
X vi$kill_undo;
X vi$undo_end := 0;
X POSITION (pos);
X RETURN (vi$abort (0));
X ENDIF;
X
X IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
X MOVE_HORIZONTAL (-1);
X ENDIF;
X
X vi$undo_end := MARK (NONE);
X
X vi$undo_start := vi$set_undo_start (orig_pos);
X vi$check_length (olen);
X ELSE
X vi$message ("Internal error while filtering!");
X ENDIF;
X ELSE
X vi$abort (0);
X ENDIF;
X ELSE
X vi$abort (0);
X ENDIF;
X
XENDPROCEDURE;
X
X!
X! Filter the region of text indicated by "region", using the command
X! given in cmd_parm.
X!
XPROCEDURE vi$filter_region (region, cmd_parm)
X LOCAL
X cmd;
X
X ON_ERROR
X vi$message ("ERROR filtering text!");
X RETURN (0);
X ENDON_ERROR;
X
X cmd := cmd_parm;
X
X IF (vi$filter_buf = 0) THEN
X vi$filter_buf := vi$init_buffer ("$$filter_buffer$$", "");
X IF (vi$filter_buf = 0) THEN
X vi$message ("Can't create buffer, filter aborted!");
X RETURN (0);
X ENDIF;
X ELSE
X ERASE (vi$filter_buf);
X ENDIF;
X
X IF (cmd = 0) THEN
X IF (vi$read_a_line ("!", cmd) = 0) THEN
X RETURN (0);
X ENDIF;
X ENDIF;
X
X vi$info_success_off;
X IF (vi$filter_proc = 0) THEN
X IF cmd = "!" THEN
X cmd := vi$last_filter;
X IF (cmd = 0) THEN
X MESSAGE ("No previous command to use!");
X RETURN (0);
X ENDIF;
X ELSE
X vi$last_filter := cmd;
X ENDIF;
X
X vi$filter_proc := CREATE_PROCESS (vi$filter_buf, cmd);
X
X IF (vi$filter_proc = 0) THEN
X vi$message ("Can't create process, filter aborted!");
X RETURN (0);
X ENDIF;
X ENDIF;
X
X SEND (region, vi$filter_proc);
X IF vi$filter_proc <> 0 THEN
X DELETE (vi$filter_proc);
X vi$filter_proc := 0;
X ENDIF;
X
X vi$info_success_on;
X
X ERASE (region);
X COPY_TEXT (vi$filter_buf);
X RETURN (1);
XENDPROCEDURE;
X
X!
X! Shift the selected text region one SHIFT_WIDTH to the right.
X!
XPROCEDURE vi$region_right
X vi$region_shift(1);
XENDPROCEDURE
X
X!
X! Shift the selected text region one SHIFT_WIDTH to the left.
X!
XPROCEDURE vi$region_left
X vi$region_shift (0);
XENDPROCEDURE
X
X!
X! This function shifts the selected region right or left based on
X! the mode passed.
X!
X! Parameters:
X! mode 0 indicates a left shift, 1 indicates right.
X!
XPROCEDURE vi$region_shift (mode)
X
X LOCAL
X act_char,
X needed,
X era_range,
X prog,
X nchar,
X copy_line,
X tab_len,
X oline,
X nline,
X state,
X orig_pos,
X last_pos,
X exitnow,
X this_pos,
X cur_tabs;
X
X ON_ERROR;
X IF state <> 0 THEN
X IF (ERROR = TPU$_ENDOFBUF) AND (state := 2) THEN
X exitnow := 1;
X ELSE
X orig_pos := 0;
X ENDIF;
X ELSE
X vi$message ("Error occured during shift, at line: "+
X STR(ERROR_LINE));
X POSITION (vi$start_pos);
X RETURN;
X ENDIF;
X ENDON_ERROR;
X
X vi$message ("");
X
X vi$start_pos := MARK (NONE);
X nchar := vi$init_action (state);
X state := 0;
X
X IF ((mode = 1) AND (ASCII (nchar) = '<')) OR
V ((mode = 0) AND (ASCII (nchar) = '>')) THE
XN
X RETURN;
X ENDIF;
X
X prog := vi$get_prog (nchar);
X
X IF prog <> "" THEN
X vi$do_movement (prog, VI$SHIFT_TYPE);
X
X oline := vi$cur_line_no;
X IF (vi$endpos <> 0) THEN
X POSITION (vi$endpos);
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X nline := vi$abs (vi$cur_line_no - oline);
X vi$endpos := MARK (NONE);
X POSITION (vi$start_pos);
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X
X IF (MARK (NONE) = vi$endpos) THEN
X MOVE_VERTICAL (1);
X vi$endpos := MARK (NONE);
X ENDIF;
X
X POSITION (vi$endpos);
X
X vi$move_horizontal (-1);
X era_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);
X MOVE_HORIZONTAL (1);
X
X IF (era_range <> 0) THEN
X vi$undo_end := 0;
X POSITION (vi$start_pos);
X vi$save_for_undo (era_range, vi$yank_mode, 1);
X
X POSITION (vi$start_pos);
X MOVE_HORIZONTAL (- CURRENT_OFFSET);
X
X orig_pos := vi$get_undo_start;
X
X cur_tabs := GET_INFO (CURRENT_BUFFER, "TAB_STOPS");
X
X IF (GET_INFO (cur_tabs, "TYPE") = STRING) THEN
X vi$message ("Can't shift region with uneven tabstops.");
X RETURN;
X ELSE
X tab_len := cur_tabs;
X ENDIF;
X
X state := 2;
X exitnow := 0;
X
X LOOP
X EXITIF MARK (NONE) = vi$endpos;
X EXITIF MARK (NONE) = END_OF (CURRENT_BUFFER);
X EXITIF (exitnow = 1);
X
X copy_line := vi$current_line;
X
X IF (copy_line <> "") THEN
X
X ! Copy line is truncated to have no leading spaces.
X
X needed := vi$vis_indent (copy_line, tab_len);
X
X IF mode = 1 THEN
X needed := needed + vi$shift_width;
X ELSE
X needed := needed - vi$shift_width;
X ENDIF;
X
X IF (needed < 0) THEN
X needed := 0;
X ENDIF;
X
X ERASE_LINE;
X COPY_TEXT (vi$get_tabs (needed, tab_len)+copy_line);
X
X MOVE_HORIZONTAL (1);
X IF (MARK (NONE) <> END_OF(CURRENT_BUFFER)) THEN
X MOVE_HORIZONTAL (-1);
X SPLIT_LINE;
X ENDIF;
X ELSE
X MOVE_VERTICAL (1);
X ENDIF;
X MOVE_HORIZONTAL (- CURRENT_OFFSET);
X ENDLOOP;
X
X MOVE_HORIZONTAL (-1);
X vi$undo_end := MARK (NONE);
X
X vi$undo_start := vi$set_undo_start (orig_pos);
X POSITION (vi$undo_start);
X IF (nline >= vi$report) THEN
X act_char := ">";
X IF mode = 0 THEN
X act_char := "<";
X ENDIF;
X vi$message (STR (nline) + " lines " + act_char + "'d");
X ENDIF;
X ELSE
X vi$message ("Internal error while shifting!");
X ENDIF;
X ELSE
X vi$abort (0);
X ENDIF;
X ELSE
X vi$abort (0);
X ENDIF;
X
XENDPROCEDURE;
X
X!
X! This procedure is called by REGION_SHIFT to calculate the number of spaces
X! occupied on the screen by the leading white space of "line". "tabstops"
X! holds the number of spaces a tab displays as obtained with a call to
X! GET_INFO (CURRENT_BUFFER, "TAB_STOPS"). Line is stripped of the leading
X! space on return, and the function returns the number of spaces occupied
X! on the screen.
X!
XPROCEDURE vi$vis_indent (line, tabstops)
X LOCAL
X idx,
X cur_ch,
X cnt;
X
X idx := 1;
X cnt := 0;
X
X LOOP
X cur_ch := SUBSTR (line, idx, 1);
X EXITIF (INDEX (" ", cur_ch) = 0);
X
X IF (cur_ch = " ") THEN
X cnt := cnt + 1;
X ELSE
X cnt := cnt + (tabstops - (cnt - ((cnt / tabstops) * tabstops)));
X ENDIF;
X
X idx := idx + 1;
X ENDLOOP;
X
X ! Truncate the line removing the leading whitespace.
X
X line := SUBSTR (line, idx, LENGTH (line) - idx + 1);
X RETURN (cnt);
XENDPROCEDURE;
X
X!
X! This procedure builds a string with as many tabs as possible to create
X! the indentation level given by "len". "tabstops" is the number of spaces
X! a tab produces on the screen.
X!
XPROCEDURE vi$get_tabs (len, tabstops)
X LOCAL
X tab_text,
X rstr;
X
X rstr := "";
X
X ! Select the proper tabbing text based on the setting of vi$use_tabs
X
X tab_text := " ";
X IF (vi$use_tabs = 0) THEN
X tab_text := SUBSTR (vi$spaces, 1, tabstops);
X ENDIF;
X
X LOOP
X EXITIF (len = 0);
X IF (len >= tabstops) THEN
X len := len - tabstops;
X rstr := rstr + tab_text;
X ELSE
X rstr := rstr + SUBSTR (vi$spaces, 1, len);
X len := 0;
X ENDIF;
X ENDLOOP;
X
X RETURN (rstr);
XENDPROCEDURE;
X
X!
X! This function should be used to abort the current keyboard stream.
X! It will assure that a macro does not continue to operate after a
X! failure.
X!
XPROCEDURE vi$abort (n)
X vi$key_buf := 0;
X RETURN (n);
XENDPROCEDURE;
X
X!
X! Decide what the current line number is.
X!
XPROCEDURE vi$cur_line_no
X LOCAL
X pos,
X cnt,
X val,
X opos;
X
X ON_ERROR
X POSITION (pos);
X IF (val > 1) THEN
X val := val / 2;
X cnt := cnt - val;
X ELSE
X POSITION (opos);
X RETURN (cnt);
X ENDIF;
X ENDON_ERROR;
X
X opos := MARK (NONE);
X val := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT") * 4 / 5;
X IF (val = 0) THEN
X val := 1;
X ENDIF;
X cnt := 1;
X LOOP
X pos := MARK (NONE);
X MOVE_VERTICAL (-val);
X cnt := cnt + val;
X ENDLOOP;
XENDPROCEDURE;
X
X!
X! Copy a buffer of keys for use later. This routine is used mostly to
X! make a copy of the last series of keystrokes from repeating when '.'
X! is typed.
X!
XPROCEDURE vi$copy_keys (to_keys, from_keys)
X LOCAL
X pos;
X
X pos := MARK (NONE);
X ERASE (to_keys);
X POSITION (to_keys);
X COPY_TEXT (from_keys);
X POSITION (BEGINNING_OF (to_keys));
X POSITION (pos);
XENDPROCEDURE;
X
X!
X! Convert a string of characters into a buffer of key strokes.
X!
XPROCEDURE vi$str_to_keybuf (tstring, tbuf)
X LOCAL
X pos,
X idx;
X
X idx := 1;
X pos := MARK (NONE);
X POSITION (BEGINNING_OF (tbuf));
X
X ! Note that a bug in TPU causes ill behavior if you try to ERASE
X ! a buffer that TPU has never written anything into.
X
X SPLIT_LINE;
X APPEND_LINE;
X ERASE (tbuf);
X
X LOOP
X EXITIF idx > LENGTH (tstring);
X COPY_TEXT (STR (KEY_NAME (SUBSTR (tstring, idx, 1))));
X MOVE_HORIZONTAL (1);
X idx := idx + 1;
X ENDLOOP;
X
X ! There must be 2 lines (the first should be blank) at the end of the
X ! buffer to make it appear exactly as a key mapping.
X
X SPLIT_LINE;
X SPLIT_LINE;
X
X POSITION (pos);
XENDPROCEDURE;
X
X!
X! Save the key passed into the push back buffer.
X!
XPROCEDURE vi$push_a_key (ch)
X LOCAL
X pos;
X
X pos := MARK (NONE);
X POSITION (vi$cur_keys);
X COPY_TEXT (STR (ch));
X MOVE_HORIZONTAL (1);
X POSITION (pos);
XENDPROCEDURE;
X
X!
X! Insert the buffer passed into the stream of key_board characters so
X! that they act as a macro.
X!
XPROCEDURE vi$insert_macro_keys (key_buf)
X LOCAL
X spos,
X pos;
X
X IF vi$push_key_buf = 0 THEN
X vi$push_key_buf := vi$init_buffer ("$$push_key_buf$$", "");
X ENDIF;
X
X pos := MARK (NONE);
X
X IF (vi$key_buf <> 0) THEN
X IF (vi$key_buf = vi$push_key_buf) THEN
X POSITION (vi$push_key_buf);
X MOVE_HORIZONTAL (-1);
X spos := MARK (NONE);
X MOVE_HORIZONTAL (1);
X SET (INSERT, CURRENT_BUFFER);
X COPY_TEXT (key_buf);
X
X ! Remove blank line at end, and possible DEFINE_KEY mapping.
X
X MOVE_VERTICAL (-1);
X ERASE_LINE;
X MOVE_VERTICAL (-1);
X ERASE_LINE;
X
X POSITION (spos);
X MOVE_HORIZONTAL (1);
X ELSE
X POSITION (vi$key_buf);
X spos := MARK (NONE);
X ERASE (vi$push_key_buf);
X POSITION (vi$push_key_buf);
X SET (INSERT, CURRENT_BUFFER);
X COPY_TEXT (CREATE_RANGE (spos, END_OF (vi$key_buf), NONE));
X
X ! Remove blank line at end, and possible DEFINE_KEY mapping.
X
X MOVE_VERTICAL (-1);
X ERASE_LINE;
X MOVE_VERTICAL (-1);
X ERASE_LINE;
X
X COPY_TEXT (key_buf);
X POSITION (BEGINNING_OF (vi$push_key_buf));
X vi$key_buf := vi$push_key_buf;
X ENDIF;
X ELSE
X ERASE (vi$push_key_buf);
X POSITION (vi$push_key_buf);
X SET (INSERT, CURRENT_BUFFER);
X COPY_TEXT (key_buf);
X vi$key_buf := vi$push_key_buf;
X POSITION (BEGINNING_OF (vi$push_key_buf));
X ENDIF;
X
X POSITION (pos);
XENDPROCEDURE;
X
X!
X! Erase a the last key pushed back.
X!
XPROCEDURE vi$del_a_key
X LOCAL
X pos;
X
X pos := MARK (NONE);
X POSITION (vi$cur_keys);
X IF MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER) THEN
X MOVE_VERTICAL (-1);
X ERASE_LINE;
X ENDIF;
X POSITION (pos);
X
XENDPROCEDURE;
X
X!
X! Read a single keystroke from either the keyboard, or from the push
X! back buffer if it is non-zero.
X!
XPROCEDURE vi$read_a_key
X
X LOCAL
X read_a_key,
X pos,
X ch;
X
X read_a_key := 0;
X
X ! If there are no keys pushed, then read the keyboard.
X
X IF (vi$key_buf = 0) OR (GET_INFO (vi$key_buf, "TYPE") <> BUFFER) THEN
X read_a_key := 1;
X vi$m_level := 0;
X IF vi$term_vt200 THEN
X ch := READ_KEY;
X ELSE
X ch := READ_CHAR;
X ENDIF;
X ELSE
X
X ! Otherwise extract the next key from the buffer.
X
X pos := MARK (NONE);
X POSITION (vi$key_buf);
X
X ! Get the key code.
X
X ch := INT (vi$current_line);
X MOVE_VERTICAL (1);
X
X ! Check for the end of the buffer.
X
X IF (LENGTH (vi$current_line) = 0) THEN
X vi$key_buf := 0;
X ENDIF;
X
X POSITION (pos);
X ENDIF;
X
X ! If we are not running on a VT200, then do some key translations
X
X IF NOT vi$term_vt200 THEN
X IF ch = ASCII(27) THEN
X ch := F11;
X ELSE
X ch := KEY_NAME (ch);
X ENDIF;
X ENDIF;
X
X ! If a key was read from the keyboard, then push it back.
X
X IF read_a_key THEN
X vi$push_a_key (ch);
X ENDIF;
X
X ! Save the last key read.
X
X vi$last_key := ch;
X
X ! Return the keycode of the character
X
X RETURN (ch);
XENDPROCEDURE;
X
X!
X! Turn pasthru on, on the terminal
X!
XPROCEDURE vi$pasthru_on
X LOCAL
X junk;
X junk := CALL_USER (vi$cu_pasthru_on, "");
XENDPROCEDURE;
X
X!
X! Turn pasthru off, on the terminal
X!
XPROCEDURE vi$pasthru_off
X LOCAL
X junk;
X junk := CALL_USER (vi$cu_pasthru_off, "");
XENDPROCEDURE;
X
X!
X! Spawn with pasthru off
X!
XPROCEDURE vi$spawn (cmd)
X LOCAL
X junk;
X
X vi$pasthru_off;
X IF (cmd = 0) THEN
X SPAWN;
X ELSE
X SPAWN (cmd);
X ENDIF;
X vi$pasthru_on;
XENDPROCEDURE
X
X!
X! Quit with pasthru off
X!
XPROCEDURE vi$quit
X vi$pasthru_off;
X QUIT;
X vi$pasthru_on;
XENDPROCEDURE
X
X!
X! Perform read_line with pasthru off
X!
XPROCEDURE vi$read_line (prompt)
X LOCAL
X junk;
X
X vi$pasthru_off;
X junk := READ_LINE (prompt);
X vi$pasthru_on;
X RETURN (junk);
XENDPROCEDURE;
X
X!
X! Initialize things by creating buffers and windows and perform other
X! assorted operations.
X!
XPROCEDURE tpu$init_procedure
X
X LOCAL
X journal_file,
X default_journal_name,
X aux_journal_name,
X cnt,
X input_file;
X
X ! Flag to indicate status of editor during startup.
X
X vi$starting_up := 1;
X
X vi$info_success_off;
X SET (MESSAGE_FLAGS, 1);
X SET (BELL, BROADCAST, ON);
X
X ! Set the variables to their initial values.
X
X vi$init_vars;
X
X ! Remove the definition of vi$init_vars to save memory.
X
X COMPILE ("procedure vi$init_vars; endprocedure;");
X
X ! Get some other information.
X
X vi$term_vt200 := GET_INFO (SCREEN, "vt200");
X vi$scr_width := GET_INFO (SCREEN, "WIDTH");
X vi$scr_length := GET_INFO (SCREEN, "VISIBLE_LENGTH");
X
X ! Create the message buffer and window.
X
X message_buffer := vi$init_buffer ("Messages", "");
X message_window := CREATE_WINDOW (vi$scr_length - 1, 2, ON);
X MAP (message_window, message_buffer);
X SET (STATUS_LINE, message_window, NONE, "");
X SET (MAX_LINES, message_buffer, 500);
X ADJUST_WINDOW (message_window, 1, 0);
X vi$mess_select (REVERSE);
X
X ! Command prompt area.
X
X command_buffer := vi$init_buffer ("Commands", "");
X command_window := CREATE_WINDOW (vi$scr_length, 1, OFF);
X
X ! Buffer for SHOW (xxx) stuff.
X
X show_buffer := vi$init_buffer ("Show", "");
X info_window := CREATE_WINDOW (1, vi$scr_length - 1, ON);
X SET (STATUS_LINE, info_window, NONE, "");
X
X ! A buffer for the tags file(s).
X
X vi$tag_buf := vi$init_buffer ("Tags buffer", "");
X vi$load_tags;
X vi$dcl_buf := vi$init_buffer ("DCL buffer", "[End of DCL buffer]");
X vi$info_success_off;
X
X ! A buffer and a window to start editing in.
X
X main_buffer := CREATE_BUFFER ("Main");
X main_window := CREATE_WINDOW (1, vi$scr_length - 1, ON);
X SET (EOB_TEXT, main_buffer, "[EOB]");
X SET (STATUS_LINE, main_window, NONE, "");
X
X ! A buffer for wild carding and such.
X
X choice_buffer := vi$init_buffer ("Choices", "");
X
X ! A buffer for the list of files we are currently editing.
X
X vi$file_names := vi$init_buffer ("file_names", "");
X
X ! Buffer to hold last text inserted into a buffer.
X
X vi$last_insert := vi$init_buffer ("$$last_insert$$", "");
X
X ! Buffer to hold KEY_NAME values of last key sequence.
X
X vi$cur_keys := vi$init_buffer ("$$current_keys$$", "");
X
X ! Buffer to hold keys to be performed when '.' is pressed.
X
X vi$last_keys := vi$init_buffer ("$$last_keys$$", "");
X
X ! Get a buffer to hold yank and deletes that are not aimed a named
X ! buffer.
X
X vi$temp_buf := vi$init_buffer ("$$temp_buffer$$", "");
X
X ! Set up some more stuff.
X
X SET (PROMPT_AREA, vi$scr_length, 1, BOLD);
X SET (JOURNALING, 7);
X SET (FACILITY_NAME, "VI");
X
X ! Move to the initial buffer.
X
X MAP (main_window, main_buffer);
X POSITION (main_buffer);
X
X ! Get the filename to edit.
X
X input_file := GET_INFO (COMMAND_LINE, "FILE_NAME");
X
X ! If there is an input file, then get it for editing.
X
X IF input_file <> "" THEN
X cnt := vi$get_file (input_file);
X ENDIF;
X
X ! Delete the unused main buffer if it is not used.
X
X IF (CURRENT_BUFFER <> main_buffer) THEN
X DELETE (main_buffer);
X ENDIF;
X
X ! Start journaling if requested.
X
X IF (GET_INFO (COMMAND_LINE, "JOURNAL") = 1) THEN
X aux_journal_name := GET_INFO (CURRENT_BUFFER, "FILE_NAME");
X
X IF aux_journal_name = "" THEN
X aux_journal_name := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE");
X ENDIF;
X
X IF aux_journal_name = 0 THEN
X aux_journal_name := "";
X ENDIF;
X
X IF aux_journal_name = "" THEN
X default_journal_name := "MAIN.TJL";
X ELSE
X default_journal_name := ".TJL";
X ENDIF;
X
X journal_file := GET_INFO (COMMAND_LINE, "JOURNAL_FILE");
X journal_file := FILE_PARSE (journal_file, default_journal_name,
X aux_journal_name);
X JOURNAL_OPEN (journal_file);
X ENDIF;
X
X ! Force undefined keystrokes ("all of them") to call vi$command_mode.
X
X SET (UNDEFINED_KEY, "tpu$key_map_list",
X COMPILE ("vi$command_mode (LAST_KEY)"));
X SET (SELF_INSERT, "tpu$key_map_list", OFF);
X
X vi$info_success_on;
X
X ! Change PF1 so that it is NOT a shift key.
X
X SET (SHIFT_KEY, KEY_NAME (PF1, SHIFT_KEY));
X
X ! Do any user added local initialization.
X
X tpu$local_init;
X
X ! Do the INI file.
X
X IF FILE_SEARCH ("EXRC") = "" THEN
X vi$do_file ("SYS$LOGIN:VI.INI", 0);
X ELSE
X vi$do_file ("EXRC", 0);
X ENDIF;
X
X vi$do_exinit;
X
X ! Enable passthru on the terminal so that ^Y does 'Push screen'.
X
X vi$pasthru_on;
X
X ! Say we are no longer starting up.
X
X vi$starting_up := 0;
XENDPROCEDURE;
X
X!
X! Process the EXINIT environment variable (Process Logical actually).
X!
XPROCEDURE vi$do_exinit
X LOCAL
X exinit;
X
X ON_ERROR
X RETURN;
X ENDON_ERROR;
X
X exinit := call_user (vi$cu_trnlnm_job, "EXINIT");
X vi$do_cmd_line (exinit);
XENDPROCEDURE;
X
X!
X! Load the file given in fn, into a buffer and execute the contents as
X! a series of EX mode commands. "complain" is boolean, and determines
X! whether or not we complain about a non existant file.
X!
XPROCEDURE vi$do_file (rfn, complain)
X LOCAL
X fn,
X ini_buffer,
X ini_file;
X
X MESSAGE ("");
X fn := rfn;
X ini_file := FILE_SEARCH ("");
X fn := FILE_PARSE (fn);
X ini_file := FILE_SEARCH (fn);
X IF (ini_file = "") THEN
X IF (complain) THEN
X vi$message ("Can't find file """+fn+"""!");
X ENDIF;
X RETURN (1);
X ENDIF;
X
X vi$info_success_off;
X
X ini_buffer := CREATE_BUFFER ("VI$CMD$INI$$", ini_file);
X
X IF ini_buffer = 0 THEN
X IF (complain) THEN
X vi$message ("can't process file """+ini_file+"""!");
X ENDIF;
X vi$info_success_on;
X RETURN(1);
X ENDIF;
X
X vi$process_buffer (ini_buffer);
X DELETE (ini_buffer);
X
X vi$info_success_on;
X RETURN (1);
XENDPROCEDURE;
X
X!
X! Execute the contents of the passed buffer as EX mode commands
X!
XPROCEDURE vi$process_buffer (buffer_parm)
X
X LOCAL
X line,
X old_pos,
X cur_pos;
X
X old_pos := MARK (NONE);
X POSITION (BEGINNING_OF (buffer_parm));
X
X LOOP
X cur_pos := MARK (NONE);
X EXITIF (cur_pos = END_OF (buffer_parm));
X line := CURRENT_LINE;
X
X IF (LENGTH (line) > 0) AND (SUBSTR (line, 1, 1) <> '!') THEN
X POSITION (old_pos);
X
X vi$do_cmd_line (line);
X
X old_pos := MARK (NONE);
X POSITION (cur_pos);
X ENDIF;
X
X MOVE_VERTICAL (1);
X ENDLOOP;
X
X POSITION (old_pos);
XENDPROCEDURE;
X
X!
X!
X!
XPROCEDURE vi$init_buffer (new_buffer_name, new_eob_text)
X
X LOCAL
X new_buffer; ! New buffer
X
X new_buffer := CREATE_BUFFER (new_buffer_name);
X SET (EOB_TEXT, new_buffer, new_eob_text);
X SET (NO_WRITE, new_buffer);
X SET (SYSTEM, new_buffer);
X RETURN (new_buffer);
X
XENDPROCEDURE;
X
X!
X! Expand the list of filenames given in "get_file_list" and return
X! the count of names found as the function value. One possible
X! match will be returned in one_name so that if only one file matches,
X! one_name will contain that file.
X!
XPROCEDURE vi$expand_file_list (get_file_list)
X
X LOCAL
X num_names,
X fres,
X one_name,
X fn,
X fl,
X comma_pos,
X pos;
X
X fl := get_file_list;
X
X ERASE (choice_buffer);
X
X IF (vi$file_names = 0) THEN
X vi$file_names := vi$init_buffer ("file_names", "");
X ELSE
X ERASE (vi$file_names);
X ENDIF;
X
X LOOP
X ! Protect against earlier file_search.
X
X fres := FILE_SEARCH ("");
X
X EXITIF fl = "";
X comma_pos := INDEX (fl, ",");
X
X IF (comma_pos > 0) THEN
X fn := SUBSTR (fl, 1, comma_pos - 1);
X fl := SUBSTR (fl, comma_pos + 1, LENGTH (fl) - comma_pos);
X ELSE
X fn := fl;
X fl := "";
X ENDIF;
X
X LOOP
X fres := FILE_SEARCH (fn);
X EXITIF fres = "";
X vi$add_choice (fres);
X one_name := fres;
X ENDLOOP;
X
X ENDLOOP;
X
X pos := MARK (NONE);
X
X POSITION (vi$file_names);
X COPY_TEXT (choice_buffer);
X POSITION (BEGINNING_OF (vi$file_names));
X
X POSITION (pos);
X
X num_names := GET_INFO (choice_buffer, "RECORD_COUNT");
X
X RETURN (num_names);
XENDPROCEDURE;
X!
X! Put a file in the current window. If the file is already in a buffer,
X! use the old buffer. If not, create a new buffer.
X!
X! Parameters:
X!
X! file_parameter String containing file name - input
X!
XPROCEDURE vi$get_file (file_parameter)
X
X LOCAL
X pos,
X obuf,
X get_file_parm,
X outfile,
X filename,
X file_read,
X get_file_name, ! Local copy of get_file_parameter
X get_file_list, ! Possible comma separated list
V temp_buffer_name, ! String for buffer name based on get_file_nam
Xe
X file_search_result, ! Latest string returned by file_search
V temp_file_name, ! First file name string returned by file_sear
Xch
X loop_cnt, ! Number of files left to process in loop
V file_cnt, ! Actual number of files found with FILE_SEARC
XH
X loop_buffer, ! Buffer currently being checked in loop
X new_buffer, ! New buffer created if needed
X found_a_buffer, ! True if buffer found with same name
X want_new_buffer; ! True if file should go into a new buffer
X
X ON_ERROR
X IF ERROR = TPU$_PARSEFAIL THEN
V vi$message (FAO ("Don't understand file name: !AS", get_file_name)
X);
X RETURN (0);
X ENDIF;
X ENDON_ERROR;
X
X obuf := CURRENT_BUFFER;
X get_file_parm := file_parameter;
X IF (get_file_parm = 0) OR (get_file_parm = "") THEN
X vi$message ("File name must be supplied!");
X RETURN (0);
X ENDIF;
X
X get_file_list := get_file_parm;
X get_file_name := get_file_parm;
X temp_file_name := 0;
X
X loop_cnt := vi$expand_file_list (get_file_list);
X
X ! If none were found, then set up to enter the loop and get a new buffer
X
X IF (loop_cnt = 0) THEN
X loop_cnt := 1;
X POSITION (BEGINNING_OF (choice_buffer));
X ELSE
X IF loop_cnt > 1 THEN
X vi$message (FAO ("!UL files to edit!", loop_cnt));
X ENDIF;
X POSITION (BEGINNING_OF (choice_buffer));
X temp_file_name := vi$current_line;
X ERASE_LINE;
X ENDIF;
X
$ GoSub Convert_File
$ Exit