gregg@a.cs.okstate.edu@mandrill.CWRU.Edu (Gregg Wonderly) (10/13/87)
$ WRITE SYS$OUTPUT "Creating ""VI.10""" $ CREATE VI.10 $ DECK/DOLLARS=$$EOD$$ IF (direction = -1) THEN LOOP EXITIF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)); MOVE_HORIZONTAL (-1); EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE); ENDLOOP; ENDIF; LOOP EXITIF ((MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) AND (direction = -1)); EXITIF ((MARK (NONE) = END_OF (CURRENT_BUFFER)) AND (direction = 1)); EXITIF (CURRENT_CHARACTER = ""); EXITIF vi$get_type (CURRENT_CHARACTER) = VI$SPACE_TYPE; MOVE_HORIZONTAL (direction); ENDLOOP; ! A hack to make change work like it is supposed to with "cw". IF (vi$command_type = VI$CHANGE_TYPE) AND (direction = 1) THEN vi$new_endpos := MARK (NONE); ENDIF; IF (direction = 1) THEN LOOP EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER)); EXITIF (CURRENT_CHARACTER = ""); MOVE_HORIZONTAL (1); EXITIF vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE; ENDLOOP; ELSE IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN MOVE_HORIZONTAL (1); ENDIF; ENDIF; RETURN (vi$retpos(pos)); ENDPROCEDURE; ! ! Move the cursor by logical words. Note that words in this case are ! delimited by a change from one type of character to another. The ! predefined types ! ! VI$ALPHA_TYPE, VI$PUNCT_TYPE, and VI$SPACE_TYPE ! ! are used to detect transitions from one word to the next; ! PROCEDURE vi$move_logical_word (direction) LOCAL this_type, this_char, pos; pos := MARK (NONE); ! If direction is back, then skip SPACE characters until no space ! is found. IF (direction = -1) THEN LOOP EXITIF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)); MOVE_HORIZONTAL (-1); EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE); ENDLOOP; ENDIF; this_char := CURRENT_CHARACTER; this_type := vi$get_type (this_char); LOOP EXITIF ((MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) AND (direction = -1)); EXITIF ((MARK (NONE) = END_OF (CURRENT_BUFFER)) AND (direction = 1)); MOVE_HORIZONTAL (direction); EXITIF (vi$get_type (CURRENT_CHARACTER) <> this_type); ENDLOOP; ! A hack to make change work like it is supposed to with "cw". IF (vi$command_type = VI$CHANGE_TYPE) AND (direction = 1) THEN vi$new_endpos := MARK (NONE); ENDIF; IF (direction = 1) THEN LOOP EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE); MOVE_HORIZONTAL (1); EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER)); ENDLOOP; ELSE IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN MOVE_HORIZONTAL (1); ENDIF; ENDIF; RETURN (vi$retpos (pos)); ENDPROCEDURE; ! ! Move the cursor by BLANK separated words. DIRECTION is either ! +1, or -1 to indicate the direction (forward, or backword respectfully) ! to move ! PROCEDURE vi$move_full_end LOCAL pos; pos := MARK (NONE); MOVE_HORIZONTAL (1); LOOP EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER)); EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE); MOVE_HORIZONTAL (1); ENDLOOP; LOOP EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER)); EXITIF (vi$get_type (CURRENT_CHARACTER) = VI$SPACE_TYPE); MOVE_HORIZONTAL (1); ENDLOOP; MOVE_HORIZONTAL (-1); RETURN (vi$retpos(pos)); ENDPROCEDURE; ! ! Move the cursor by logical words. Note that words in this case are ! delimited by a change from one type of character to another. The ! predefined types ! ! VI$ALPHA_TYPE, VI$PUNCT_TYPE, and VI$SPACE_TYPE ! ! are used to detect transitions from one word to the next; ! PROCEDURE vi$move_logical_end LOCAL this_type, this_char, pos; pos := MARK (NONE); MOVE_HORIZONTAL (1); LOOP EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER)); EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE); MOVE_HORIZONTAL (1); ENDLOOP; this_char := CURRENT_CHARACTER; this_type := vi$get_type (this_char); LOOP EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER)); EXITIF (vi$get_type (CURRENT_CHARACTER) <> this_type); MOVE_HORIZONTAL (1); ENDLOOP; MOVE_HORIZONTAL (-1); RETURN (vi$retpos (pos)); ENDPROCEDURE; ! ! Return the logical type of the character passed. This is typically used ! by the move_by_word routines to determine when a word ends. ! PROCEDURE vi$get_type (this_char) LOCAL this_type; IF (this_char = "") THEN RETURN (VI$EOL_TYPE); ENDIF; this_type := VI$SPACE_TYPE; IF (INDEX (vi$_alpha_chars, this_char) <> 0) THEN this_type := VI$ALPHA_TYPE; ELSE IF (INDEX (vi$_punct_chars, this_char) <> 0) THEN this_type := VI$PUNCT_TYPE; ENDIF; ENDIF; RETURN (this_type); ENDPROCEDURE; ! ! This procedure determines what line the cursor is currently positioned ! on. and then prints that information, along with other items of interest ! in the message window. ! PROCEDURE vi$what_line LOCAL percent, mod, outfile, lines, nowr, pos, cnt; ON_ERROR; lines := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT"); IF (cnt) > lines THEN cnt := lines; ENDIF; IF lines = 0 THEN percent := 0; ELSE percent := (cnt*100)/lines; ENDIF; vi$message (FAO ("!ASLine !UL of !UL, !UL%, !AS!AS", nowr, cnt, lines, percent, mod, outfile)); SET (TIMER, OFF); RETURN; ENDON_ERROR; nowr := " "; IF (GET_INFO (CURRENT_BUFFER, "NO_WRITE")) THEN nowr := "*"; ENDIF; mod := ""; IF GET_INFO (CURRENT_BUFFER, "MODIFIED") THEN mod := "[modified] "; ENDIF; pos := MARK(NONE); MOVE_HORIZONTAL (- CURRENT_OFFSET); cnt := 0; lines := 0; outfile := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE"); IF (outfile = 0) THEN outfile := "Not Edited"; ELSE outfile := """"+outfile+""""; ENDIF; cnt := vi$cur_line_no; POSITION (pos); lines := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT"); IF (cnt) > lines THEN cnt := lines; ENDIF; IF lines = 0 THEN percent := 0; ELSE percent := (cnt*100)/lines; ENDIF; vi$message (FAO ("!ASLine !UL of !UL, !UL%, !AS!AS", nowr, cnt, lines, percent, mod, outfile)); SET (TIMER, OFF); ENDPROCEDURE; ! ! This function moves to "pos" if it is non-zero. If "pos" is zero, then ! any current macro is aborted, and the current position is not changed. ! "save_pos" is a boolean value that indicates whether or not the current ! location is remembered so that it can be returned to later with the ! "'" (go to marker) command. ! PROCEDURE vi$position (pos, save_pos) IF (pos <> 0) THEN IF save_pos THEN vi$old_place := MARK (NONE); ENDIF; POSITION (pos); ELSE RETURN (vi$abort (0)); ENDIF; RETURN (pos); ENDPROCEDURE; ! ! This function implements the command mode function of joining the ! current line with the one below it. ! ! The undo operation consists of deleting the line created by joining ! the two lines, and then inserting the original contents of the two ! joined lines. ! PROCEDURE vi$_join_lines LOCAL start, end, spos, epos, pos, plen, len; ON_ERROR ! Throw away moved beyond end of buffer messages. RETURN; ENDON_ERROR; spos := MARK (NONE); MOVE_HORIZONTAL (-CURRENT_OFFSET); pos := MARK (NONE); IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN MOVE_VERTICAL (1); IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN MOVE_VERTICAL (1); MOVE_HORIZONTAL (-1); epos := MARK (NONE); POSITION (spos); vi$save_for_undo (CREATE_RANGE (pos, epos, NONE), VI$LINE_MODE, 1); POSITION (pos); ELSE RETURN; ENDIF; ELSE RETURN; ENDIF; MOVE_HORIZONTAL (LENGTH (vi$current_line)); LOOP EXITIF (CURRENT_OFFSET = 0); MOVE_HORIZONTAL (-1); EXITIF INDEX (" ", CURRENT_CHARACTER) = 0; ERASE_CHARACTER (1); ENDLOOP; plen := LENGTH (vi$current_line); vi$_next_line; IF (CURRENT_OFFSET > 0) AND (plen > 0) THEN ERASE_CHARACTER (-CURRENT_OFFSET); ENDIF; len := LENGTH (vi$current_line); APPEND_LINE; IF (len > 0) AND (plen > 0) THEN COPY_TEXT (" "); MOVE_HORIZONTAL (-1); ELSE vi$check_rmarg; ENDIF; pos := MARK (NONE); MOVE_HORIZONTAL (-CURRENT_OFFSET); vi$undo_start := MARK (NONE); MOVE_HORIZONTAL (LENGTH (vi$current_line)); vi$undo_end := MARK (NONE); POSITION (pos); ENDPROCEDURE; ! ! This function filters the selected region through the command ! given. ! PROCEDURE vi$region_filter LOCAL era_range, prog, nchar, copy_line, orig_pos, last_pos, pos, exitnow, olen, this_pos, cur_tabs; vi$message (""); 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); MOVE_HORIZONTAL (-CURRENT_OFFSET); vi$endpos := MARK (NONE); POSITION (vi$start_pos); MOVE_HORIZONTAL (-CURRENT_OFFSET); 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); MOVE_HORIZONTAL (- CURRENT_OFFSET); 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$message ("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$message ("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$message ("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 MESSAGE ("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$message ("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$message ("Error occured during shift, at line: "+ STR(ERROR_LINE)); POSITION (vi$start_pos); RETURN; ENDIF; ENDON_ERROR; vi$message (""); 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); MOVE_HORIZONTAL (-CURRENT_OFFSET); nline := vi$abs (vi$cur_line_no - oline); vi$endpos := MARK (NONE); POSITION (vi$start_pos); MOVE_HORIZONTAL (-CURRENT_OFFSET); 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); MOVE_HORIZONTAL (- CURRENT_OFFSET); orig_pos := vi$get_undo_start; cur_tabs := GET_INFO (CURRENT_BUFFER, "TAB_STOPS"); IF (GET_INFO (cur_tabs, "TYPE") = STRING) THEN vi$message ("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; MOVE_HORIZONTAL (- CURRENT_OFFSET); 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$message (STR (nline) + " lines " + act_char + "'d"); ENDIF; ELSE vi$message ("Internal error while shifting!"); ENDIF; ELSE vi$abort (0); ENDIF; ELSE vi$abort (0); ENDIF; ENDPROCEDURE; ! ! This procedure is called by REGION_SHIFT 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 (INDEX (" ", 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 := " "; 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") * 4 / 5; 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 (KEY_NAME (SUBSTR (tstring, idx, 1)))); 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 (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; ELSE ch := KEY_NAME (ch); ENDIF; ENDIF; ! 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$info_success_off; SET (MESSAGE_FLAGS, 1); SET (BELL, BROADCAST, ON); ! Set the variables to their initial values. vi$init_vars; ! Remove the definition of vi$init_vars to save memory. COMPILE ("procedure vi$init_vars; endprocedure;"); ! 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 a named ! buffer. 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 there is an input file, then get it for editing. IF input_file <> "" THEN cnt := vi$get_file (input_file); ENDIF; ! Delete the unused main buffer if it is not used. IF (CURRENT_BUFFER <> main_buffer) 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; MESSAGE (""); fn := rfn; ini_file := FILE_SEARCH (""); fn := FILE_PARSE (fn); ini_file := FILE_SEARCH (fn); IF (ini_file = "") THEN IF (complain) THEN vi$message ("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$message ("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; ! ! ! 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. One possible ! match will be returned in one_name so that if only one file matches, ! one_name will contain that file. ! PROCEDURE vi$expand_file_list (get_file_list) LOCAL num_names, fres, one_name, 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; 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); one_name := fres; ENDLOOP; ENDLOOP; pos := MARK (NONE); POSITION (vi$file_names); COPY_TEXT (choice_buffer); POSITION (BEGINNING_OF (vi$file_names)); POSITION (pos); 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_searc h 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$message (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$message ("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$message (FAO ("!UL files to edit!", loop_cnt)); ENDIF; POSITION (BEGINNING_OF (choice_buffer)); temp_file_name := vi$current_line; ERASE_LINE; ENDIF; $$EOD$$