gregg@a.cs.okstate.edu (Gregg Wonderly) (09/27/88)
Posting-number: Volume 4, Issue 101 Submitted-by: "Gregg Wonderly" <gregg@a.cs.okstate.edu> Archive-name: vms-vi-2/Part10 $ WRITE SYS$OUTPUT "Creating ""VI.6""" $ CREATE VI.6 $ DECK/DOLLARS=$$EOD$$ ELSE IF (vi$wrap_scan = 1) THEN POSITION (BEGINNING_OF (CURRENT_BUFFER)); ENDIF; ENDIF; ELSE prompt := "?" + vi$search_string; SET (REVERSE, CURRENT_BUFFER); IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN IF (SUBSTR (prompt, 1, 3) = "?\<") THEN MOVE_HORIZONTAL (-2); ELSE MOVE_HORIZONTAL (-1); ENDIF; ELSE IF (vi$wrap_scan = 1) THEN POSITION (END_OF (CURRENT_BUFFER)); ENDIF; ENDIF; ENDIF; MESSAGE (prompt); ! On success then return the position we moved to. cnt := vi$cur_active_count; LOOP where := vi$find_str (vi$search_string, 0, 0); EXITIF (where = 0); POSITION (BEGINNING_OF (where)); IF (CURRENT_DIRECTION = FORWARD) THEN MOVE_HORIZONTAL (1); ELSE MOVE_HORIZONTAL (-1); ENDIF; cnt := cnt - 1; EXITIF cnt = 0; ENDLOOP; IF (where = 0) THEN vi$info ("String not found"); ELSE POSITION (BEGINNING_OF (where)); bpos := MARK (NONE); POSITION (END_OF (where)); vi$find_rng := CREATE_RANGE (bpos, MARK(NONE), BOLD); MESSAGE (""); ENDIF; POSITION (pos); RETURN (where); ENDPROCEDURE; ! ! This procedure can be used to find a string of text (using RE's). ! The current direction of the BUFFER is used to determine which way ! the search goes. 'replace' is used by the replace code to indicate ! that wrap scan should be performed. ! PROCEDURE vi$find_str (sstr, replace, do_parens) LOCAL pos, new_pat, start, where; ON_ERROR ENDON_ERROR; pos := MARK (NONE); vi$paren_cnt := 0; IF vi$magic THEN new_pat := vi$re_pattern_gen (sstr, vi$paren_cnt, do_parens); ELSE new_pat := vi$pattern_gen (sstr); ENDIF; IF (new_pat <> 0) THEN EXECUTE (COMPILE ("vi$_find_pat := " + new_pat)); where := SEARCH (vi$_find_pat, CURRENT_DIRECTION, vi$ignore_case); IF (where = 0) AND (vi$wrap_scan = 1) AND (replace = 0) THEN IF (CURRENT_DIRECTION = FORWARD) THEN POSITION (BEGINNING_OF (CURRENT_BUFFER)); ELSE POSITION (END_OF (CURRENT_BUFFER)); ENDIF; where := SEARCH (vi$_find_pat, CURRENT_DIRECTION, vi$ignore_case); ENDIF; ELSE where := 0; ENDIF; IF (where <> 0) AND (vi$in_ws) THEN POSITION (BEGINNING_OF (where)); IF (CURRENT_OFFSET <> 0) OR (INDEX (vi$_ws, CURRENT_CHARACTER) <> 0) THEN MOVE_HORIZONTAL (1); ENDIF; start := MARK (NONE); POSITION (END_OF (where)); IF (CURRENT_OFFSET <> LENGTH (CURRENT_LINE)) THEN MOVE_HORIZONTAL (-1); ENDIF; where := CREATE_RANGE (start, MARK (NONE), NONE); POSITION (pos); ENDIF; RETURN (where); ENDPROCEDURE; ! ! Generate a TPU pattern string, not using RE's, i.e. :set nomagic is ! in effect when this routine is used. ! PROCEDURE vi$pattern_gen (pat) LOCAL first, ! First pattern to be done part_pat, chno, startchar, haveany, regular, tstr, endchar, str_pat, cur_pat, ! The current pattern to be extracted cur_char, ! The current character in the regular ! expression being examined new_pat, ! The output pattern pos; ! The position within the regular ! expression string that we are examining ! currently IF (INDEX (pat, "$") <> 0) OR (INDEX (pat, "^") <> 0) THEN new_pat := ""; ELSE new_pat := '"'+pat+'"'; RETURN (new_pat); ENDIF; pos := 1; IF SUBSTR (pat, pos, 1) = "^" THEN IF LENGTH (pat) > 1 THEN new_pat := "line_begin & '"; ELSE new_pat := "line_begin"; ENDIF; pos := pos + 1; ENDIF; LOOP EXITIF (pos > LENGTH (pat)); regular := 0; cur_pat := ""; cur_char := substr (pat, pos, 1); IF (cur_char = "$") AND (pos+1 >= LENGTH (pat)) THEN IF pos <> 1 THEN cur_pat := "' & line_end"; ELSE cur_pat := "line_end"; ENDIF; ELSE cur_pat := cur_char; regular := 1; ENDIF; IF (regular) THEN new_pat := new_pat + cur_pat; ELSE IF new_pat = "" THEN new_pat := cur_pat; ELSE new_pat := new_pat + "&" + cur_pat; ENDIF; ENDIF; pos := pos + 1; ENDLOOP; IF (regular) THEN new_pat := new_pat + "'"; ENDIF; RETURN (new_pat); ENDPROCEDURE; ! ! ! TPU pattern generator. Generates a pattern string from the passed ! RE string. The function is used when :set magic is in effect. ! PROCEDURE vi$re_pattern_gen (pat, paren_cnt, do_parens) LOCAL first, ! First pattern to be done part_pat, chno, startchar, haveany, regular, tstr, endchar, pat_str, str_pat, cur_pat, ! The current pattern to be extracted cur_char, ! The current character in the regular ! expression being examined new_pat, ! The output pattern in_ws, pos; ! The position within the regular ! expression string that we are examining ! currently vi$in_ws := 0; IF ((INDEX (pat, "$") <> 0) OR (INDEX (pat, "[") <> 0) OR (INDEX (pat, "^") <> 0) OR (INDEX (pat, ".") <> 0) OR (INDEX (pat, "*") <> 0) OR (INDEX (pat, "\") <> 0) OR (INDEX (pat, '"') <> 0)) THEN new_pat := ""; ELSE new_pat := '"'+pat+'"'; RETURN (new_pat); ENDIF; in_ws := 0; pos := 1; IF SUBSTR (pat, pos, 1) = "^" THEN new_pat := "line_begin"; pos := pos + 1; ENDIF; LOOP EXITIF (pos > LENGTH (pat)); regular := 0; cur_pat := ""; cur_char := substr (pat, pos, 1); pat_str := ""; IF (cur_char = "^") THEN vi$info ("^ found in the middle of a line, use \ to escape it!"); RETURN (0); ENDIF; IF (cur_char = "$") THEN IF (pos >= LENGTH (pat)) THEN cur_pat := "line_end"; ELSE vi$info ("$ found before end of string"); RETURN (0); ENDIF; ELSE IF cur_char = "[" THEN pos := pos + 1; IF SUBSTR (pat, pos, 1) = "^" THEN pos := pos + 1; part_pat := "notany('"; ELSE part_pat := "any('"; ENDIF; LOOP EXITIF pos > LENGTH (pat); EXITIF SUBSTR (pat, pos, 1) = "]"; IF SUBSTR (pat, pos, 1) = "\" THEN pos := pos + 1; IF pos > LENGTH (pat) THEN vi$info ("Missing character after \"); RETURN (0); ENDIF; ENDIF; startchar := SUBSTR (pat, pos, 1); pat_str := pat_str + startchar; IF startchar = "'" THEN pat_str := pat_str + "'"; ENDIF; IF (SUBSTR (pat, pos+1, 1) = '-') THEN pos := pos + 2; IF (pos >= LENGTH (pat)) THEN vi$info ("Missing character after '-'"); RETURN (0); ENDIF; endchar := SUBSTR (pat, pos, 1); chno := 1; LOOP EXITIF (ASCII(chno) = startchar); chno := chno + 1; ENDLOOP; LOOP chno := chno + 1; IF (chno > 255) THEN vi$info ( "Invalid character sequence for '-'"); RETURN (0); ENDIF; EXITIF (ASCII (chno-1) = endchar); pat_str := pat_str + ASCII (chno); IF ASCII (chno) = "'" THEN pat_str := pat_str + "'"; ENDIF; ENDLOOP; ENDIF; pos := pos + 1; ENDLOOP; IF pat_str = "" THEN vi$info ("No text found between []"); RETURN (0); ENDIF; IF (SUBSTR (pat, pos+1, 1) = "*") THEN IF (part_pat = "notany('") THEN cur_pat := cur_pat + "(scan('"+pat_str+"')|"""")"; ELSE cur_pat := cur_pat + "(span('"+pat_str+"')|"""")"; ENDIF; pos := pos + 1; ELSE cur_pat := part_pat + pat_str + "')"; ENDIF; ELSE tstr := '"'; haveany := 0; regular := 1; LOOP cur_char := SUBSTR (pat, pos, 1); EXITIF (cur_char = "^") OR (cur_char = "[") OR (cur_char = "$"); EXITIF (pos > LENGTH (pat)); IF cur_char = "\" THEN pos := pos + 1; startchar := SUBSTR (pat, pos, 1); IF (do_parens) THEN IF (startchar = "(") THEN paren_cnt := paren_cnt + 1; IF tstr = '"' THEN tstr := '""@o'+STR(paren_cnt)+'&"'; ELSE tstr := tstr + '"@o'+STR(paren_cnt)+'&"'; ENDIF; ELSE IF (startchar = ")") THEN IF (paren_cnt = 0) THEN vi$info ( FAO ("No previous ""\("" near: !AS", SUBSTR (pat, pos, LENGTH(pat)-pos)) ); RETURN (0); ENDIF; IF tstr = '"' THEN tstr := '""@p'+STR(paren_cnt)+'&"'; ELSE tstr := tstr + '"@p' + STR(paren_cnt)+'&"'; ENDIF; ELSE IF (startchar = "<") THEN in_ws := 1; vi$in_ws := 1; tstr := tstr + '"&(line_begin | any (vi$_ws))&"'; ELSE IF (startchar = ">") THEN in_ws := 0; tstr := tstr + '"&(line_end | any (vi$_ws))&"'; ELSE tstr := tstr + SUBSTR (pat, pos, 1); ENDIF; ENDIF; ENDIF; ENDIF; ELSE IF (startchar = "<") THEN in_ws := 1; vi$in_ws := 1; tstr := tstr + '"&(line_begin | any (vi$_ws))&"'; ELSE IF (startchar = ">") THEN in_ws := 0; tstr := tstr + '"&(line_end | any (vi$_ws))&"'; ELSE tstr := tstr + startchar; ENDIF; ENDIF; ENDIF; ELSE IF (cur_char = ".") THEN cur_char := "longer_than_1"; ENDIF; IF (SUBSTR (pat, pos+1, 1) = '*') THEN pos := pos + 1; IF (LENGTH (cur_char) > 1) THEN cur_pat := "span(vi$pch)"; ELSE cur_pat := "span('"+cur_char+"')"; ENDIF; tstr := tstr+'"&'+cur_pat+'&"'; haveany := 0; ELSE IF (LENGTH (cur_char) > 1) THEN IF (haveany) THEN tstr := tstr +'"&'+"arb(1)"+'&"'; haveany := 0; ELSE IF (LENGTH (tstr)>0) and (tstr <> '"') THEN tstr := tstr +'"&'+"arb(1)"+'&"'; ELSE tstr := "arb(1)"+'&"'; ENDIF ENDIF; ELSE IF (cur_char = """") THEN tstr := tstr + '""'; haveany := haveany + 2; ELSE tstr := tstr + cur_char; haveany := haveany + 1; ENDIF; ENDIF; ENDIF; ENDIF; pos := pos + 1; ENDLOOP; cur_pat := tstr + '"'; pos := pos - 1; ENDIF; ENDIF; IF (regular) THEN IF new_pat = "" THEN new_pat := cur_pat; ELSE IF (LENGTH (tstr) > 1) THEN new_pat := new_pat + "&" + cur_pat; ENDIF; ENDIF; ELSE IF new_pat = "" THEN new_pat := cur_pat; ELSE new_pat := new_pat + "&" + cur_pat; ENDIF; ENDIF; pos := pos + 1; ENDLOOP; IF (in_ws) THEN vi$info ("Missing \> in pattern!"); RETURN (0); ENDIF; RETURN (new_pat); ENDPROCEDURE; ! ! Match brackets when '%' is typed. ! PROCEDURE vi$_match_brackets vi$beep_position (vi$match_brackets, 1, 1); ENDPROCEDURE; ! ! Perform the actual match bracket operation. ! PROCEDURE vi$match_brackets LOCAL newpos, ind_pos, found, cur_ch, cur_dir, pos; ON_ERROR IF ERROR = TPU$_CONTROLC THEN vi$beep; vi$pasthru_on; RETURN (0); ENDIF; ENDON_ERROR; found := 1; MESSAGE (""); pos := MARK (NONE); cur_ch := CURRENT_CHARACTER; ind_pos := INDEX (vi$bracket_chars, cur_ch); IF (ind_pos = 0) THEN newpos := SEARCH (ANCHOR & SCAN (")") & ARB (1), FORWARD, EXACT); found := 0; IF newpos <> 0 THEN found := 1; IF vi$in_show_match = 0 THEN vi$old_place := pos; ENDIF; POSITION (END_OF (newpos)); RETURN (vi$retpos (pos)); ELSE POSITION (pos); RETURN (0); ENDIF; ENDIF; IF ((ind_pos/2)*2 <> ind_pos) THEN cur_dir := FORWARD; ELSE cur_dir := REVERSE; ENDIF; SET (TIMER, ON, "Searching..."); newpos := vi$do_match (CURRENT_CHARACTER, cur_dir, 0); SET (TIMER, OFF); IF (GET_INFO (newpos, "TYPE") = MARKER) THEN RETURN (vi$retpos (pos)); ELSE IF (newpos = 0) AND NOT (vi$in_show_match) THEN vi$info ("No matching bracket"); ENDIF; POSITION (pos); ENDIF; RETURN (0); ENDPROCEDURE; ! ! ! This procedure knows how to traverse nested brackets to find the matching ! bracket. It takes the character that the cursor is positioned on, and ! finds the matching one. It recognizes '{}', '[]', '()' pairs. ! PROCEDURE vi$do_match (bracket, cur_dir, level) LOCAL dgrp, dest_char, sel_reg, ind_pos, next_pos, possibles, cur_ch; ON_ERROR RETURN (0); ENDON_ERROR; IF level > 30 THEN vi$info ("Too many nested levels"); RETURN (-1); ENDIF; ! Identify the desired search direction based on the character. ind_pos := INDEX (vi$bracket_chars, bracket); dest_char := SUBSTR ("}{)(][", ind_pos, 1); IF cur_dir = FORWARD THEN MOVE_HORIZONTAL (1); ENDIF; dgrp := bracket + dest_char; LOOP sel_reg := SEARCH (ANY (dgrp), cur_dir, EXACT); IF sel_reg = 0 THEN RETURN (0); ENDIF; POSITION (BEGINNING_OF (sel_reg)); IF (CURRENT_CHARACTER = dest_char) THEN RETURN (MARK (NONE)); ELSE IF (((INDEX ("([{", CURRENT_CHARACTER) <> 0) AND (cur_dir = FORWARD)) OR ((INDEX (")}]", CURRENT_CHARACTER) <> 0) AND (cur_dir = REVERSE))) THEN IF (INDEX (vi$bracket_chars, CURRENT_CHARACTER)-1)/2 <= (INDEX (vi$bracket_chars, dest_char)-1)/2 THEN next_pos := vi$do_match (CURRENT_CHARACTER, cur_dir, level+1); IF (next_pos <> 0) AND (next_pos <> -1) THEN POSITION (next_pos); ELSE RETURN (next_pos); ENDIF; ENDIF; ELSE IF (INDEX (vi$bracket_chars, CURRENT_CHARACTER) = 0) THEN vi$info ("Unknown bracket character: '"+ CURRENT_CHARACTER+"'"); RETURN (-1); ENDIF; ENDIF; IF cur_dir = FORWARD THEN MOVE_HORIZONTAL (1); ENDIF; ENDIF; ENDLOOP; ENDPROCEDURE; ! ! Move to the top line of the window when 'H' is pressed. ! PROCEDURE vi$home POSITION (vi$to_home); ENDPROCEDURE; ! ! Perform the actual movement for the 'H' command and return the marker. ! PROCEDURE vi$to_home LOCAL pos; ON_ERROR ! Ignore attempt to move beyond end of buffer errors. ENDON_ERROR; pos := MARK (NONE); MOVE_VERTICAL ( GET_INFO (CURRENT_WINDOW, "VISIBLE_TOP") - GET_INFO (CURRENT_WINDOW, "CURRENT_ROW")); vi$yank_mode := VI$LINE_MODE; RETURN (vi$retpos(pos)); ENDPROCEDURE ! ! Position the cursor into the middle of the current window when 'M' is ! pressed. ! PROCEDURE vi$middle POSITION (vi$to_middle); ENDPROCEDURE; ! ! Perform the actual movement of the 'M' command. ! PROCEDURE vi$to_middle LOCAL len, cur, top, pos; ON_ERROR ! Ignore attempt to move beyond end of buffer errors. ENDON_ERROR; pos := MARK (NONE); len := GET_INFO (CURRENT_WINDOW, "VISIBLE_LENGTH"); cur := GET_INFO (CURRENT_WINDOW, "CURRENT_ROW"); top := GET_INFO (CURRENT_WINDOW, "VISIBLE_TOP"); MOVE_VERTICAL ((top + len/2 - 1) - cur); vi$yank_mode := VI$LINE_MODE; RETURN (vi$retpos(pos)); ENDPROCEDURE; ! ! Move the the last line of the current window when 'L' is pressed. ! PROCEDURE vi$last POSITION (vi$to_last); ENDPROCEDURE; ! ! Perform the actual movement associated with the 'L' command. ! PROCEDURE vi$to_last LOCAL pos; ON_ERROR ! Ignore attempt to move beyond end of buffer errors. ENDON_ERROR; pos := MARK (NONE); MOVE_VERTICAL ( GET_INFO (CURRENT_WINDOW, "VISIBLE_BOTTOM") - GET_INFO (CURRENT_WINDOW, "CURRENT_ROW")); vi$yank_mode := VI$LINE_MODE; RETURN (vi$retpos (pos)); ENDPROCEDURE ! ! Move to the end of the current line when '$' is pressed. ! PROCEDURE vi$_eol POSITION (vi$eol); ENDPROCEDURE; ! ! Perform the actual movement associated with the '$' command. ! PROCEDURE vi$eol LOCAL cnt, pos; ON_ERROR POSITION (pos); vi$active_count := 0; RETURN (0); ENDON_ERROR; pos := MARK (NONE); POSITION (LINE_BEGIN); cnt := vi$active_count; IF cnt = 0 THEN cnt := 1; ENDIF; MOVE_VERTICAL (cnt - 1); IF (CURRENT_CHARACTER = "") THEN RETURN (0); ENDIF; POSITION (LINE_END); vi$check_rmarg; IF (vi$active_count > 0) THEN vi$yank_mode := VI$LINE_MODE; ELSE vi$yank_mode := VI$IN_LINE_MODE; ENDIF; vi$active_count := 0; RETURN (vi$retpos (pos)); ENDPROCEDURE; ! ! Move the first non-blank character of the line when '^' is typed. ! PROCEDURE vi$_bol (use_cur_active) vi$beep_position (vi$first_no_space (use_cur_active), 0, 1); ENDPROCEDURE; ! ! Move the beginning of the line when '0' is typed. ! PROCEDURE vi$fol LOCAL pos; pos := MARK (NONE); POSITION (LINE_BEGIN); vi$yank_mode := VI$IN_LINE_MODE; vi$new_offset := 1; RETURN (vi$retpos (pos)); ENDPROCEDURE; ! ! Move the the location searched for. ! PROCEDURE vi$_search (direction) LOCAL opos, pos; opos := MARK (NONE); pos := vi$search(direction); IF (vi$beep_position (pos, 1, 0) <> 0) THEN POSITION (opos); vi$pos_in_middle (pos); ENDIF; ENDPROCEDURE; ! ! Move to the next location of the string previously searched for. ! PROCEDURE vi$_search_next (direction) LOCAL opos, pos; opos := MARK(NONE); pos := vi$search_next(direction); IF (vi$beep_position (pos, 1, 0) <> 0) THEN POSITION (opos); vi$pos_in_middle (pos); ENDIF; ENDPROCEDURE; ! ! Repeat the last 't' or 'f' command backwards. ! PROCEDURE vi$_repeat_torf_back vi$beep_position (vi$repeat_torf_back, 0, 1); ENDPROCEDURE ! ! Repeat the last 't' or 'f' command. ! PROCEDURE vi$_repeat_torf vi$beep_position (vi$repeat_torf, 0, 1); ENDPROCEDURE ! ! Return the location found by repeating the last 't', 'f', 'T' or 'F' ! command backwards. ! PROCEDURE vi$repeat_torf_back LOCAL ch, old_func, back_func; IF vi$last_s_func = 0 THEN RETURN (0); ENDIF; old_func := vi$last_s_func; IF (vi$last_s_func = "vi$back_find_char") THEN back_func := "vi$find_char"; ENDIF; IF (vi$last_s_func = "vi$find_char") THEN back_func := "vi$back_find_char"; ENDIF; IF (vi$last_s_func = "vi$back_to_char") THEN back_func := "vi$to_char"; ENDIF; IF (vi$last_s_func = "vi$to_char") THEN back_func := "vi$back_to_char"; ENDIF; vi$global_var := 0; ch := vi$last_s_char; IF (ch = "'") THEN ch := "''"; ENDIF; EXECUTE (COMPILE ( "vi$global_var := " + back_func + "('"+ ch + "')")); vi$last_s_func := old_func; RETURN (vi$global_var); ENDPROCEDURE ! ! Return the location found by repeating the last 't', 'f', 'T' or 'F' ! command. ! PROCEDURE vi$repeat_torf LOCAL ch; vi$global_var := 0; ch := vi$last_s_char; IF (ch = "'") THEN ch := "''"; ENDIF; IF (vi$last_s_func <> 0) THEN EXECUTE (COMPILE ( "vi$global_var := " + vi$last_s_func + "('"+ ch + "')")); ELSE vi$beep; ENDIF; RETURN (vi$global_var); ENDPROCEDURE ! ! Return the value of a positive integer that is represented as a string. ! If the string is not a valid integer, then -1 is retured. ! PROCEDURE vi$number_from_string (str_num) ON_ERROR RETURN (-1); ENDON_ERROR; RETURN (INT (str_num)); ENDPROCEDURE; ! ! Move to the line indicated by 'line_no', and return the marker that ! indicates the beginning of that line. ! PROCEDURE vi$mark_line (line_no) LOCAL pos; ON_ERROR POSITION (pos); RETURN (0); ENDON_ERROR; pos := MARK (NONE); POSITION (BEGINNING_OF (CURRENT_BUFFER)); MOVE_VERTICAL (line_no - 1); RETURN (vi$retpos (pos)); ENDPROCEDURE; ! ! Perform an EX mode command after a ':' is typed. ! PROCEDURE vi$ex_mode LOCAL cmd_str; IF (vi$read_a_line (":", cmd_str) <> 0) and (cmd_str <> "") THEN vi$do_cmd_line (cmd_str); ENDIF; ENDPROCEDURE; ! ! ! PROCEDURE vi$read_a_line (prompt, cmd_str) LOCAL cmd_idx, addch, ch, did_ctl_v, win, pos; win := CURRENT_WINDOW; pos := MARK (NONE); POSITION (END_OF (command_buffer)); MAP (command_window, command_buffer); COPY_TEXT (prompt); SET (OVERSTRIKE, CURRENT_BUFFER); cmd_str := ""; cmd_idx := 0; LOOP vi$update (CURRENT_WINDOW); ch := vi$read_a_key; did_ctl_v := 0; IF ch = CTRL_V_KEY THEN COPY_TEXT ("^"); did_ctl_v := 1; MOVE_HORIZONTAL (-1); vi$update (CURRENT_WINDOW); ch := vi$read_a_key; ERASE_CHARACTER (1); ENDIF; EXITIF ((ch = RET_KEY) OR (ch = F11)) AND (did_ctl_v = 0); IF (ch = RET_KEY) THEN ch := CTRL_M_KEY; ENDIF; IF (ch = F12) THEN ch := CTRL_H_KEY; ENDIF; IF (ch = F11) THEN ch := KEY_NAME (ASCII (27)); ENDIF; IF ((ch = DEL_KEY) OR (ch = CTRL_H_KEY)) AND (did_ctl_v = 0) THEN IF cmd_idx = 0 THEN UNMAP (command_window); UNMAP (message_window); MAP (message_window, message_buffer); POSITION (win); POSITION (pos); RETURN (0); ENDIF; ch := SUBSTR (cmd_str, cmd_idx, 1); cmd_idx := cmd_idx - 1; IF (INDEX (vi$_ctl_chars, ch) <> 0) THEN MOVE_HORIZONTAL (-2); ELSE MOVE_HORIZONTAL (-1); ENDIF; cmd_str := SUBSTR (cmd_str, 1, cmd_idx); ELSE IF (INT(ch) <= INT(KEY_NAME (ASCII (31)))) AND (INT (ch) >= INT(CTRL_A_KEY)) THEN IF ch = TAB_KEY THEN addch := 9; COPY_TEXT (ASCII(addch)); ELSE addch := ((INT(ch) - INT(CTRL_A_KEY)) / 256) + 1; COPY_TEXT ("^"); COPY_TEXT (ASCII (addch + 64)); ENDIF; cmd_str := cmd_str + ASCII (addch); cmd_idx := cmd_idx + 1; IF ch = 27 THEN ch := F11; ENDIF; ELSE IF (ch = UP) THEN vi$next_in_cmd (cmd_str, cmd_idx, prompt, -1); ELSE IF (ch = DOWN) THEN vi$next_in_cmd (cmd_str, cmd_idx, prompt, 1); ELSE COPY_TEXT (ASCII(ch)); cmd_str := cmd_str + ASCII (ch); cmd_idx := cmd_idx + 1; ENDIF; ENDIF; ENDIF; ENDIF; ENDLOOP; ERASE_CHARACTER (LENGTH (CURRENT_LINE) - CURRENT_OFFSET); vi$update (CURRENT_WINDOW); IF (cmd_idx > 0) THEN POSITION (END_OF (command_buffer)); LOOP MOVE_VERTICAL (-1); EXITIF (CURRENT_LINE <> prompt); ERASE_LINE; ENDLOOP; IF (CURRENT_LINE <> prompt + cmd_str) THEN MOVE_VERTICAL (1); COPY_TEXT (prompt + cmd_str); ENDIF; ENDIF; UNMAP (command_window); UNMAP (message_window); MAP (message_window, message_buffer); POSITION (win); POSITION (pos); RETURN (cmd_idx > 0); ENDPROCEDURE; ! ! This procedure looks from the next occurence of 'prompt' at the ! beginning of the line, in the direction dir (1 or -1). If prompt ! is found, then cmd_str is set to the contents of that line, minus ! the text of the prompt, and cmd_idx is set to the length of cmd_str. ! The cursor is left positioned at the end of the line found, or if ! none is found, it is not moved. ! PROCEDURE vi$next_in_cmd (cmd_str, cmd_idx, prompt, dir) LOCAL pos, len; ON_ERROR POSITION (pos); RETURN; ENDON_ERROR; pos := MARK (NONE); len := LENGTH (prompt); POSITION (LINE_BEGIN); LOOP EXITIF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) AND (dir = -1); EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER)) AND (dir = 1); MOVE_VERTICAL (DIR); IF SUBSTR (CURRENT_LINE, 1, len) = prompt THEN cmd_str := SUBSTR (CURRENT_LINE, len+1, LENGTH (CURRENT_LINE) - len + 1); cmd_idx := LENGTH (cmd_str); POSITION (LINE_END); RETURN; ENDIF; ENDLOOP; POSITION (pos); ENDPROCEDURE; ! ! Perform a whole series of command separated by '|'s. ! PROCEDURE vi$do_cmd_line (cmd) LOCAL ch, retval, idx, strg; idx := 1; strg := ""; LOOP EXITIF (idx > LENGTH (cmd)); ch := SUBSTR (cmd, idx, 1); IF (ch = "|") THEN retval := vi$do_command (strg); IF (retval > 1) THEN RETURN (retval); ENDIF; strg := ""; ELSE IF (ch = "\") THEN idx := idx + 1; IF (SUBSTR (cmd, idx, 1) = "|") THEN strg := strg + "|"; ELSE strg := strg + "\" + SUBSTR (cmd, idx, 1); ENDIF; ELSE strg := strg + ch; ENDIF; ENDIF; idx := idx + 1; ENDLOOP; IF (strg <> "") THEN IF (vi$do_command (strg) <> 0) THEN RETURN (1); ENDIF; ENDIF; RETURN (0); ENDPROCEDURE; ! ! Perform an EX (not all are implemented) command as given in "cmd". ! PROCEDURE vi$do_command (cmd) LOCAL rng, outf, mode, token_1, token_2, token_3, res_spec, start_mark, end_mark, start_line, end_line, work_range, whole_range, buf, spos, rest, separ, no_spec, ch, i, j, olen, bang, num, pos; olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT"); ! Start at beginning of string and look for a range of lines. i := 1; pos := MARK (NONE); num := vi$get_line_spec (i, cmd); IF (num < 0) THEN vi$info ("search line not found!"); POSITION (pos); RETURN (1); ENDIF; no_spec := 0; IF (num <= 0) THEN IF (vi$parse_next_ch (i, cmd, "%")) THEN start_line := 1; end_line := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT"); ELSE no_spec := 1; start_line := vi$cur_line_no; end_line := start_line; ENDIF; ELSE start_line := num; IF (vi$parse_next_ch (i, cmd, ",")) THEN num := vi$get_line_spec (i, cmd); IF (num < 0) THEN vi$info ("Invalid line range specification!"); RETURN (1); ENDIF; end_line := num; ELSE end_line := start_line; ENDIF; ENDIF; POSITION (pos); work_range := 0; whole_range := 0; IF (start_line > end_line) THEN vi$info ("Bad range of lines!"); RETURN (1); ENDIF; start_mark := vi$mark_line (start_line); end_mark := vi$mark_line (end_line); IF (start_mark = 0) OR (end_mark = 0) THEN vi$info ("Bad range of lines!"); RETURN (1); ENDIF; work_range := CREATE_RANGE (start_mark, end_mark, NONE); pos := MARK (NONE); POSITION (end_mark); IF (end_mark <> END_OF (CURRENT_BUFFER)) THEN MOVE_VERTICAL (1); ENDIF; IF (end_mark <> BEGINNING_OF (CURRENT_BUFFER)) THEN MOVE_HORIZONTAL (-1); ENDIF; whole_range := CREATE_RANGE (start_mark, MARK (NONE), NONE); POSITION (pos); ! If there is no command then move to the line indicated. rest := vi$rest_of_line (cmd, i); EDIT (rest, COLLAPSE); IF rest = "" THEN vi$old_place := MARK (NONE); POSITION (start_mark); RETURN (0); ENDIF; token_1 := vi$get_cmd_token (vi$_lower_chars, cmd, i); IF (vi$leading_str (token_1, "version") AND (LENGTH (token_1) > 2)) THEN vi$info (vi$_version); RETURN (0); ENDIF; IF (token_1 = "help") THEN RETURN (vi$do_help (vi$rest_of_line (cmd, i))); ENDIF; IF (token_1 = "show") THEN RETURN (vi$do_show (cmd, i)); ENDIF; ! Check for substitution alias. IF (token_1 = "") AND (vi$parse_next_ch (i, cmd, "&")) THEN RETURN (vi$do_subs_alias (cmd, i, start_line, end_line, whole_range)); ENDIF; IF (token_1 = "") AND (vi$parse_next_ch (i, cmd, "@")) THEN RETURN (vi$do_macro_buffer (cmd, i)); ENDIF; IF (token_1 = "learn") THEN RETURN (vi$do_learn (cmd, i)); ENDIF; IF (token_1 = "unlearn") THEN RETURN (vi$do_unlearn (cmd, i)); ENDIF; IF (token_1 = "v") THEN RETURN (vi$do_global (cmd, i, "v")); ENDIF; IF (token_1 = "g") THEN RETURN (vi$do_global (cmd, i, "g")); ENDIF; IF (token_1 = "sh") OR (token_1 = "dcl") THEN RETURN (vi$spawn (0)); ENDIF; IF (vi$leading_str (token_1, "unabbr") AND (LENGTH (token_1) > 4)) THEN RETURN (vi$do_unabbr (cmd, i)); ENDIF; IF (vi$leading_str (token_1, "abbr") AND (LENGTH (token_1) > 3)) THEN RETURN (vi$do_abbr (cmd, i)); ENDIF; IF (vi$leading_str (token_1, "edit")) OR (token_1 = "vi") THEN RETURN (vi$do_edit (cmd, i, token_1)); ENDIF; IF (token_1 = "") THEN IF (vi$parse_next_ch (i, cmd, "!")) THEN RETURN (vi$do_subproc (cmd, i)); ENDIF; ENDIF; IF (vi$leading_str (token_1, "copy")) THEN RETURN (vi$do_copy (cmd, i, whole_range, olen, start_line, end_line)); ENDIF; IF (vi$leading_str (token_1, "move")) THEN RETURN (vi$do_move (cmd, i, whole_range, start_line, end_line)); ENDIF; IF (vi$leading_str (token_1, "select")) AND (LENGTH (token_1) > 2) THEN RETURN (vi$do_select); ENDIF; IF (token_1 = "fill") THEN RETURN (vi$do_fill (cmd, i, whole_range, olen)); ENDIF; IF ((LENGTH (token_1) > 1) AND (vi$leading_str (token_1, "upper") OR vi$leading_str (token_1, "lower") OR vi$leading_str (token_1, "invert"))) THEN RETURN (vi$do_case (token_1, whole_range)); ENDIF; IF (token_1 = "s") THEN RETURN (vi$do_substitute (start_line, end_line, whole_range, i, cmd)); ENDIF; IF (token_1 = "d") THEN RETURN (vi$do_delete (start_mark, whole_range, olen)); ENDIF; ! Do the write file command. You can write either a buffer, or a ! portion of one. IF (vi$leading_str (token_1, "write")) THEN RETURN (vi$do_write (cmd, i, no_spec, token_1, whole_range)); ENDIF; IF (token_1 = "wq") THEN RETURN (vi$do_wq (cmd, i, no_spec, token_1, whole_range)); ENDIF; IF (token_1 = "p") THEN RETURN (vi$do_print (start_mark, start_line, end_line)); ENDIF; ! Read in a file to the current buffer. IF (vi$leading_str (token_1, "read")) THEN RETURN (vi$do_read (cmd, i, start_line, olen)); ENDIF; IF (vi$leading_str (token_1, "file")) THEN RETURN (vi$do_file_ex (cmd, i)); ENDIF; IF (vi$leading_str (token_1, "buffer")) THEN RETURN (vi$do_buffer (cmd, i, token_1)); ENDIF; IF (token_1 = "so") THEN RETURN (vi$do_file (vi$rest_of_line (cmd, i), 1)); ENDIF; IF (vi$leading_str (token_1, "messages")) THEN RETURN (vi$do_messages); ENDIF; IF (vi$leading_str (token_1, "delbuf")) THEN RETURN (vi$do_delbuf (cmd, i)); ENDIF; IF (vi$leading_str (token_1, "xit")) THEN RETURN (vi$_ZZ (KEY_NAME ('Z'))); ENDIF; IF (token_1 = "rew") THEN RETURN (vi$_first_file (vi$parse_next_ch (i, cmd, "!"))); ENDIF; IF (vi$leading_str (token_1, "prev")) THEN RETURN (vi$_previous_file (vi$parse_next_ch (i, cmd, "!"))); ENDIF; IF (vi$leading_str (token_1, "next")) THEN RETURN (vi$_next_file (vi$parse_next_ch (i, cmd, "!"))); ENDIF; IF (token_1 = "tag") OR (token_1 = "ta") THEN token_1 := vi$parse_next_ch (i, cmd, "!"); vi$skip_white (cmd, i); IF (vi$rest_of_line (cmd, i) = "") THEN RETURN (vi$do_tag (0)); ELSE RETURN (vi$do_tag (vi$rest_of_line (cmd, i))); ENDIF; ENDIF; IF (token_1 = "map") THEN RETURN (vi$map_keys (cmd, i)); ENDIF; IF (token_1 = "unmap") THEN RETURN (vi$unmap_keys (cmd, i)); ENDIF; IF (token_1 = "set") OR (token_1 = "se") THEN RETURN (vi$set_commands (cmd, i)); ENDIF; IF (token_1 = "tpu") THEN RETURN (vi$do_tpu (cmd, i, no_spec, whole_range)); ENDIF; IF (token_1 = "cd") OR (token_1 = "chdir") THEN RETURN (vi$do_cd (cmd, i)); ENDIF; ! Quit the current editor session. IF (vi$leading_str (token_1, "quit")) THEN RETURN (vi$do_quit (cmd, token_1)); ENDIF; vi$info ("Unrecognized command! ("+cmd+")"); RETURN (1); ENDPROCEDURE; ! ! ! PROCEDURE vi$do_unlearn (cmd, i) LOCAL keyn, com; vi$info ("Press the key you want to unlearn: "); keyn := vi$read_a_key; IF (keyn = F11) OR (ASCII (27) = ASCII (keyn)) THEN vi$info ("UNLEARN aborted!"); RETURN (1); ENDIF; com := LOOKUP_KEY (keyn, COMMENT, vi$cmd_keys); IF (com <> "learn_sequence") THEN vi$info ("That key is not a learned KEY!"); RETURN (1); ENDIF; UNDEFINE_KEY (keyn, vi$cmd_keys); ENDPROCEDURE; ! ! ! PROCEDURE vi$do_learn (cmd, i) LOCAL keyn, strg; vi$info ("Type KEY sequence, and press CTRL-R to remember sequence"); vi$in_learn := 1; LEARN_BEGIN (EXACT); RETURN (1); ENDPROCEDURE; ! ! Remember the keystrokes that have been typed. ! PROCEDURE vi$remember LOCAL key, keyn, com; ON_ERROR RETURN (1); ENDON_ERROR; IF (vi$in_learn = 0) THEN RETURN (0); ENDIF; $$EOD$$