gregg@a.cs.okstate.edu (Gregg Wonderly) (09/27/88)
Posting-number: Volume 4, Issue 103 Submitted-by: "Gregg Wonderly" <gregg@a.cs.okstate.edu> Archive-name: vms-vi-2/Part12 $ WRITE SYS$OUTPUT "Creating ""VI.8""" $ CREATE VI.8 $ DECK/DOLLARS=$$EOD$$ RETURN (1); ENDIF; vi$pos_in_middle (MARK (NONE)); ENDIF; ELSE POSITION (pos); vi$info ("Tag not in tags file"); RETURN (1); ENDIF; RETURN (0); ENDPROCEDURE; ! ! Return the word that is spanned by characters in the symbol set. ! PROCEDURE vi$sym_name LOCAL ch; ch := ""; LOOP EXITIF INDEX (vi$_sym_chars, CURRENT_CHARACTER) = 0; ch := ch + CURRENT_CHARACTER; MOVE_HORIZONTAL (1); ENDLOOP; RETURN (ch); ENDPROCEDURE; ! ! Return the word that is spanned by non-blank characters. ! PROCEDURE vi$space_word LOCAL ch; ch := ""; LOOP EXITIF (CURRENT_CHARACTER = " ") OR (CURRENT_CHARACTER = ASCII (9)); ch := ch + CURRENT_CHARACTER; MOVE_HORIZONTAL (1); ENDLOOP; RETURN (ch); ENDPROCEDURE; ! ! Perform the EX mode tpu command. ! PROCEDURE vi$do_tpu (cmd, i, no_spec, whole_range) ON_ERROR RETURN (1); ENDON_ERROR; IF no_spec AND (vi$rest_of_line (cmd, i) <> "") THEN EXECUTE (COMPILE (vi$rest_of_line (cmd, i))); ELSE vi$info ("Compiling..."); IF no_spec AND (vi$rest_of_line (cmd, i) = "") THEN IF (vi$select_pos <> 0) THEN EXECUTE (COMPILE (SELECT_RANGE)); vi$select_pos := 0; MESSAGE (""); ELSE vi$info ("Nothing selected to compile!"); RETURN (1); ENDIF; ELSE COMPILE (whole_range); ENDIF; ENDIF; RETURN (1); ENDPROCEDURE; ! ! ! PROCEDURE vi$do_wq (cmd, i, no_spec, token_1, whole_range) vi$do_write (cmd, i, no_spec, token_1, whole_range); vi$do_quit (cmd, token_1); RETURN (1); ENDPROCEDURE; ! ! Perform the EX mode quit command. ! PROCEDURE vi$do_quit (cmd, token_1) LOCAL buf; buf := GET_INFO (BUFFERS, "FIRST"); LOOP EXITIF buf = 0; IF GET_INFO (buf, "MODIFIED") AND (NOT GET_INFO (buf, "SYSTEM")) THEN IF NOT GET_INFO (buf, "NO_WRITE") THEN IF INDEX (cmd, "!") <> 0 THEN SET (NO_WRITE, buf); ELSE vi$info ("No write of buffer """+GET_INFO (buf, "NAME") + """ since last change, use """+token_1 + "!"" to override."); RETURN (1); ENDIF; ENDIF; ENDIF; buf := GET_INFO (BUFFERS, "NEXT"); ENDLOOP; vi$quit; RETURN (1); ENDPROCEDURE; ! ! Delete the buffer given by the name passed as the parameter. The buffer ! must not be the current buffer, or if it is, there must be more than ! one buffer on the screen. ! PROCEDURE vi$do_delbuf (cmd, i) LOCAL win, confirm, possible_buffer, possible_buffer_name, found_a_buffer, how_many_buffers, this_buffer, loop_buffer, bang, buffer_name; ! Get the buffer name, solving abiguity problems. bang := vi$parse_next_ch (i, cmd, "!"); vi$skip_white (cmd, i); buffer_name := vi$rest_of_line (cmd, i); CHANGE_CASE (buffer_name, UPPER); ! for messages loop_buffer := vi$find_buffer_by_name (buffer_name); IF (loop_buffer <> 0) THEN buffer_name := GET_INFO (loop_buffer, "NAME"); ! Now, we must first delete all windows mapped to this buffer. win := GET_INFO (WINDOWS, "FIRST"); LOOP EXITIF (win = 0); EXITIF (GET_INFO (loop_buffer, "MAP_COUNT") = 0); ! See if current window is mapped to this buffer. IF (GET_INFO (win, "BUFFER") = loop_buffer) THEN ! If so, there must be a previous or a next window to move to. ! If there is not, then we can not delete the buffer until ! another buffer (and window) are available to move to. IF (vi$prev_win (win) <> 0) OR (vi$next_win(win) <> 0) THEN POSITION (win); vi$del_win (win); ! Restart at beginning of list. Deleting a window will ! make "NEXT" not work. win := GET_INFO (WINDOWS, "FIRST"); ELSE vi$info ("Can't unmap all windows that are mapped to """ + buffer_name + """!"); RETURN (1); ENDIF; ELSE win := GET_INFO (WINDOWS, "NEXT"); ENDIF; ENDLOOP; ELSE vi$info ("No such buffer, "+buffer_name); RETURN (1); ENDIF; CHANGE_CASE (buffer_name, UPPER); IF (GET_INFO (loop_buffer, "MAP_COUNT") = 0) THEN IF (GET_INFO (loop_buffer, "MODIFIED") AND NOT bang) THEN confirm := READ_LINE ("Delete modified buffer, """+ buffer_name+"""? "); EDIT (confirm, UPPER); IF (SUBSTR (confirm, 1, 1) <> "Y") THEN vi$info ("Buffer NOT deleted!"); RETURN (1); ENDIF; ENDIF; DELETE (loop_buffer); vi$info ("Buffer, """+buffer_name+""", deleted!"); ELSE vi$info ("Can't delete """+buffer_name+ """, it is still mapped to a window!"); RETURN (1); ENDIF; ! Normally we would return 0, but the above message must remain visible. RETURN (1); ENDPROCEDURE; ! ! Return the proper value of a MARKER that indicates the previous position ! in the current buffer. ! PROCEDURE vi$get_undo_start LOCAL pos; IF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) THEN RETURN (0); ELSE MOVE_HORIZONTAL (-1); pos := MARK (NONE); MOVE_HORIZONTAL (1); RETURN (pos); ENDIF; ENDPROCEDURE; ! ! Use "spos" to determine where "vi$undo_start" should be set. ! PROCEDURE vi$set_undo_start (spos) IF spos = 0 THEN RETURN (BEGINNING_OF (CURRENT_BUFFER)); ELSE POSITION (spos); MOVE_HORIZONTAL (1); RETURN (MARK (NONE)); ENDIF; ENDPROCEDURE; ! ! If this was real VI under UNIX, all you would need to do is filter text ! through NROFF... sigh... I guess you can't have it all? ! PROCEDURE vi$fill_region (leftm, rightm, rng) LOCAL pos, tend, spos, beg; IF (leftm = 0) THEN leftm := 1; ENDIF; IF (rightm = 0) THEN rightm := vi$scr_width - vi$wrap_margin; ENDIF; POSITION (BEGINNING_OF (rng)); LOOP EXITIF (CURRENT_CHARACTER <> " ") AND (CURRENT_CHARACTER <> ASCII (9)); MOVE_HORIZONTAL (1); EXITIF (MARK (NONE) = END_OF (rng)); ENDLOOP; beg := MARK (NONE); POSITION (END_OF (rng)); MOVE_HORIZONTAL (-1); tend := MARK (NONE); rng := CREATE_RANGE (beg, tend, NONE); POSITION (BEGINNING_OF (rng)); vi$save_for_undo (rng, VI$IN_LINE_MODE, 1); spos := vi$get_undo_start; FILL (rng, " ", leftm, rightm); vi$undo_end := MARK (NONE); vi$undo_start := vi$set_undo_start (spos); POSITION (vi$undo_start); ENDPROCEDURE; ! ! Given a buffer name, return the buffer TYPE variable for that buffer. ! PROCEDURE vi$find_buffer_by_name (bname_param) LOCAL cnt, bname, possible, pbuf, buf; bname := bname_param; CHANGE_CASE (bname, UPPER); buf := GET_INFO (BUFFERS, "FIRST"); cnt := 0; LOOP EXITIF buf = 0; possible := GET_INFO (buf, "NAME"); EXITIF bname = possible; IF vi$leading_str (bname, possible) THEN cnt := cnt + 1; pbuf := buf; ENDIF; buf := GET_INFO (BUFFERS, "NEXT"); ENDLOOP; IF buf = 0 THEN IF cnt = 1 THEN buf := pbuf; ENDIF; ENDIF; RETURN (buf); ENDPROCEDURE; ! ! Effect a key mapping, and squirl away the original mapping so that ! it can be restore later. ! PROCEDURE vi$map_keys (cmd, i) LOCAL comment_string, separ, pos, buf, map_type, keyn, key; map_type := vi$cmd_keys; IF (vi$parse_next_ch (i, cmd, "!")) THEN map_type := vi$edit_keys; ENDIF; IF SUBSTR (cmd, i, 1) <> " " THEN vi$show_maps; RETURN(1); ENDIF; vi$skip_white (cmd, i); IF (i > LENGTH (cmd)) THEN vi$show_maps; RETURN (1); ENDIF; key := KEY_NAME (SUBSTR (cmd, i, 1)); i := i + 1; comment_string := LOOKUP_KEY (key, COMMENT, map_type); vi$skip_white (cmd, i); key := INT (key); IF (key < 32) THEN key := ((INT(CTRL_B_KEY) - INT(CTRL_A_KEY)) * (key - 1)) + INT(CTRL_A_KEY); ENDIF; keyn := vi$key_map_name (key); IF (map_type = vi$edit_keys) AND (comment_string <> 0) AND (comment_string <> "") AND (comment_string <> "active_macro") THEN vi$info ("You can't redefine that key!"); RETURN (1); ENDIF; vi$global_var := 0; buf := 0; ! The callable TPU interface can create certain problems, as it ! may cause the key definitions to hang around when the map ! buffers have actually been deleted. Mail can do this! As a ! result, the following code detects when the map buffer is ! missing, and creates a new one. The original meaning of ! any key that is mapped in this way is necessarily lost. IF comment_string = "active_macro" THEN EXECUTE (COMPILE ("vi$global_var := vi$$key_map_buf_" + keyn + map_type + ";")); buf := vi$global_var; ! If buf is zero at this point, then the key map buffer ! has been deleted. ELSE EXECUTE (COMPILE ( "vi$global_var := vi$init_buffer ('vi$$key_map_" + keyn + map_type + "', '');")); IF (vi$global_var = 0) THEN vi$info ("Can't create buffer for key map!"); RETURN; ENDIF; EXECUTE (COMPILE ("vi$$key_map_buf_" + keyn + map_type + " := vi$global_var;")); ! Pass the flag. buf := 1; ENDIF; ! New key map, save old map into keymap buffer. IF (GET_INFO (buf, "TYPE") = INTEGER) THEN buf := vi$global_var; pos := MARK (NONE); POSITION (buf); SPLIT_LINE; COPY_TEXT (comment_string); ELSE ! Old map should be erased first. IF (GET_INFO (buf, "TYPE") = BUFFER) THEN pos := MARK (NONE); POSITION (BEGINNING_OF (buf)); LOOP EXITIF (CURRENT_LINE = ""); ERASE_LINE; ENDLOOP; ELSE ! Key map buffer has been deleted, create a new one. EXECUTE (COMPILE ( "vi$global_var := vi$init_buffer ('vi$$key_map_" + keyn + map_type + "', '');")); IF (vi$global_var = 0) THEN vi$info ("Can't create buffer for key map!"); RETURN; ENDIF; EXECUTE (COMPILE ("vi$$key_map_buf_" + keyn + map_type + " := vi$global_var;")); buf := vi$global_var; pos := MARK (NONE); POSITION (buf); SPLIT_LINE; COPY_TEXT ("vi$lost_definition"); ENDIF; ENDIF; POSITION (BEGINNING_OF (buf)); LOOP EXITIF (i > LENGTH (cmd)); COPY_TEXT (STR (INT (KEY_NAME (SUBSTR (cmd, i, 1))))); SPLIT_LINE; i := i + 1; ENDLOOP; POSITION (BEGINNING_OF (buf)); POSITION (pos); vi$info_success_off; IF (map_type = vi$edit_keys) THEN EXECUTE (COMPILE ("DEFINE_KEY ('vi$insert_macro_keys (vi$$key_map_buf_" + keyn + map_type + ")', KEY_NAME(" + STR(key) + "), 'active_macro', vi$edit_keys);")); ELSE EXECUTE (COMPILE ("DEFINE_KEY ('vi$do_macro (vi$$key_map_buf_" + keyn + map_type + ", 1)', KEY_NAME(" + STR(key) + "), 'active_macro', vi$cmd_keys);")); ENDIF; vi$info_success_on; RETURN (0); ENDPROCEDURE; ! ! Unmap a key mapping and restore the original if one existed. ! PROCEDURE vi$unmap_keys (cmd, i) LOCAL comment_string, separ, pos, buf, map_type, keyn, key; map_type := vi$cmd_keys; IF (SUBSTR (cmd, i, 1) = "!") THEN map_type := vi$edit_keys; i := i + 1; ELSE IF SUBSTR (cmd, i, 1) <> " " THEN vi$info ("Bad command!"); RETURN; ENDIF; ENDIF; vi$skip_white (cmd, i); key := KEY_NAME (SUBSTR (cmd, i ,1)); comment_string := LOOKUP_KEY (key, COMMENT, map_type); IF comment_string <> "active_macro" THEN vi$info ("Key not currently mapped!"); RETURN; ENDIF; key := INT (key); IF (key < 32) THEN key := ((INT(CTRL_B_KEY) - INT(CTRL_A_KEY)) * (key - 1)) + INT(CTRL_A_KEY); ENDIF; keyn := vi$key_map_name (key); vi$global_var := 0; EXECUTE (COMPILE ("vi$global_var := vi$$key_map_buf_" + keyn + map_type + ";")); buf := vi$global_var; pos := MARK (NONE); POSITION (END_OF (buf)); MOVE_VERTICAL (-1); vi$info_success_off; EXECUTE (COMPILE ("DEFINE_KEY ('"+CURRENT_LINE + "', "+STR(key)+", '"+CURRENT_LINE+"', '" + map_type + "')")); vi$info_success_on; POSITION (pos); DELETE (buf); vi$info ("Key now unmapped!"); ENDPROCEDURE; ! ! ! PROCEDURE vi$lost_definition vi$info ("Key definition lost!"); ENDPROCEDURE; ! ! Show current keyboard mappings. ! PROCEDURE vi$show_maps LOCAL com, key_type, keyn, key, bpos, npos, pos, buf; pos := MARK (NONE); buf := choice_buffer; POSITION (buf); ERASE (buf); key_type := vi$cmd_keys; COPY_TEXT ("COMMAND KEY MAPS:"); SPLIT_LINE; LOOP keyn := GET_INFO (DEFINED_KEY, "first", key_type); LOOP EXITIF (keyn = 0); com := LOOKUP_KEY (keyn, COMMENT, key_type); IF (com = "active_macro") THEN key := vi$key_map_name (keyn); vi$global_var := 0; EXECUTE (COMPILE ("vi$global_var:=vi$$key_map_buf_"+ key+key_type)); IF (vi$global_var <> 0) AND (GET_INFO (vi$global_var, "TYPE") = BUFFER) THEN key := vi$ascii_name (keyn); COPY_TEXT (" "+key+SUBSTR (" ", 1, 4-LENGTH(key))+'"'); npos := MARK (NONE); POSITION (BEGINNING_OF (vi$global_var)); LOOP keyn := CURRENT_LINE; EXITIF (LENGTH (keyn) < 8); bpos := MARK (NONE); POSITION (npos); COPY_TEXT (vi$ascii_name (INT(keyn))); POSITION (bpos); MOVE_VERTICAL (1); ENDLOOP; POSITION (npos); COPY_TEXT ('"'); SPLIT_LINE; ENDIF; ENDIF; keyn := GET_INFO (DEFINED_KEY, "next", key_type); ENDLOOP; EXITIF (key_type = vi$edit_keys); key_type := vi$edit_keys; SPLIT_LINE; COPY_TEXT ("EDITING KEY MAPS:"); SPLIT_LINE; ENDLOOP; APPEND_LINE; POSITION (BEGINNING_OF (buf)); POSITION (pos); vi$show_list (buf, " Current MAPPINGS" + " ", info_window); RETURN (0); ENDPROCEDURE; ! ! Generate a unique string based on a KEY_NAME value. ! PROCEDURE vi$key_map_name (key) LOCAL k; k := key; IF (GET_INFO (key, "TYPE") = KEYWORD) THEN k := INT (key); ENDIF; RETURN (SUBSTR(FAO("!XL", key),1,6)); ENDPROCEDURE; ! ! Increment "i" until it is no longer indexing a blank or tab in "cmd". ! PROCEDURE vi$skip_white (cmd, i) LOOP EXITIF i > LENGTH (cmd); EXITIF (INDEX (vi$_space_tab, SUBSTR(cmd, i, 1)) = 0); i := i + 1; ENDLOOP; ENDPROCEDURE; ! ! Given a string, extract a line specification that is either absolute, ! relative, or an RE pattern expression. ! PROCEDURE vi$get_line_spec (idx, cmd) LOCAL ch, sch, num; num := 0; ch := SUBSTR (cmd, idx, 1); IF (ch = "/") OR (ch = "?") THEN idx := idx + 1; sch := ch; num := ""; LOOP EXITIF (vi$parse_next_ch (idx, cmd, sch)); EXITIF (LENGTH (cmd) < idx); ch := SUBSTR (cmd, idx, 1); IF (ch = "\") THEN num := num + SUBSTR (cmd, idx, 2); idx := idx + 1; ELSE num := num + ch; ENDIF; idx := idx + 1; ENDLOOP; IF (LENGTH (cmd) < idx - 1) THEN vi$info ("Oops, improper expression!"); RETURN (-1); ENDIF; ch := SUBSTR (cmd, idx, 1); IF sch = "?" THEN SET (REVERSE, CURRENT_BUFFER); ELSE SET (FORWARD, CURRENT_BUFFER); ENDIF; num := vi$find_str (num, 0, 0); IF (num <> 0) THEN num := BEGINNING_OF (num); POSITION (num); num := vi$cur_line_no; ELSE RETURN (-1); ENDIF; ELSE IF (ch = "'") THEN ch := SUBSTR (cmd, idx+1, 1); idx := idx + 2; vi$global_var := 0; EXECUTE (COMPILE ("vi$global_var:=vi$mark_"+ch)); IF (vi$global_var <> 0) THEN POSITION (vi$global_var); num := vi$cur_line_no; ELSE RETURN (-1); ENDIF; ELSE LOOP ch := SUBSTR (cmd, idx, 1); EXITIF (INDEX (vi$_numeric_chars, ch) = 0); IF (num < 0) THEN num := INT (ch); ELSE num := num * 10 + INT (ch); ENDIF; idx := idx + 1; ENDLOOP; ENDIF; ENDIF; IF (ch = ".") THEN num := vi$cur_line_no; idx := idx + 1; IF (vi$parse_next_ch (idx, cmd, "+")) THEN num := num + vi$get_line_spec (idx, cmd); ENDIF; ELSE IF (ch = "$") THEN num := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT"); idx := idx + 1; ELSE IF (ch = "+") THEN num := num + vi$get_line_spec (idx, cmd); ENDIF; ENDIF; ENDIF; RETURN (num); ENDPROCEDURE; ! ! If the character at location "idx" in "cmd" is "try", then increment ! "idx" and return TRUE, otherwise return FALSE. ! PROCEDURE vi$parse_next_ch (idx, cmd, try) IF (SUBSTR (cmd, idx, 1) = try) THEN idx := idx + 1; RETURN (1); ENDIF; RETURN (0); ENDPROCEDURE; ! ! A function to get the string, in "cmd", that is spanned by the characters ! in "mask". "idx" is incremented to point past this string, and the string ! is returned as the function value. ! PROCEDURE vi$get_cmd_token (mask, cmd, idx) LOCAL token, ch; token := ""; vi$skip_white (cmd, idx); LOOP EXITIF (idx > LENGTH (cmd)); ch := SUBSTR (cmd, idx, 1); EXITIF (INDEX (mask, ch) = 0); token := token + ch; idx := idx + 1; ENDLOOP; RETURN (token); ENDPROCEDURE; ! ! A function to see if the string "token" is a lead substring of "cmd". ! PROCEDURE vi$leading_str (token, cmd) RETURN ((token <> "") AND (INDEX (cmd, token) = 1)); ENDPROCEDURE; ! ! A routine that looks for the first occurance of a character in ! "seps", in "cmd", and then changes "idx" to reflect that locatation. ! "separ" will contain the character in "seps" that was actually found. ! PROCEDURE vi$skip_separ (cmd, idx, seps, separ) LOCAL nch, retstr; retstr := ""; separ := ""; vi$skip_white (cmd, idx); LOOP EXITIF (idx > LENGTH (cmd)); nch := SUBSTR (cmd, idx, 1); idx := idx + 1; IF (INDEX (seps, nch) <> 0) OR (nch = " ") OR (nch = ASCII (9)) THEN separ := nch; RETURN (retstr); ENDIF; retstr := retstr + nch; ENDLOOP; RETURN (retstr); ENDPROCEDURE; ! ! A procedure that returns the characters occuring at index, "idx", and ! after in the string "cmd". ! PROCEDURE vi$rest_of_line (cmd, idx) RETURN (SUBSTR (cmd, idx, LENGTH (cmd)-idx + 1)); ENDPROCEDURE; ! ! SET (INFORMATIONAL/SUCCESS) short procedures. ! PROCEDURE vi$info_success_off vi$info_off; vi$success_off; ENDPROCEDURE; PROCEDURE vi$info_success_on vi$info_on; vi$success_on; ENDPROCEDURE; PROCEDURE vi$success_off SET (SUCCESS, OFF); ENDPROCEDURE; PROCEDURE vi$success_on SET (SUCCESS, ON); ENDPROCEDURE; PROCEDURE vi$info_off SET (INFORMATIONAL, OFF); ENDPROCEDURE; PROCEDURE vi$info_on SET (INFORMATIONAL, ON); ENDPROCEDURE; ! ! Called from vi$do_global to perform a substitution during a global command. ! PROCEDURE vi$global_subs (cmd, nsubs) LOCAL idx, result_text, replace_text, hrange, ch, pos, spos, epos, lpos, source, scount, dest, query, doglobal, replace, separ; idx := 1; separ := vi$next_char (cmd, idx); source := ""; dest := ""; doglobal := 0; query := 0; LOOP IF (idx > LENGTH (cmd)) THEN vi$info ("Insufficent arguments!"); RETURN (0); ENDIF; ch := SUBSTR (cmd, idx, 1); EXITIF ch = separ; source := source + ch; idx := idx + 1; ENDLOOP; idx := idx + 1; LOOP EXITIF idx > LENGTH (cmd); ch := SUBSTR (cmd, idx, 1); EXITIF ch = separ; dest := dest + ch; idx := idx + 1; ENDLOOP; idx := idx + 1; LOOP EXITIF idx > LENGTH (cmd); ch := SUBSTR (cmd, idx, 1); IF (ch = "q") or (ch = "c") THEN query := 1; ELSE IF ch = "g" THEN doglobal := 1; ELSE vi$info ("Unrecognized command qualifier '"+ch+"'"); RETURN (0); ENDIF; ENDIF; idx := idx + 1; ENDLOOP; vi$replace_source := source; vi$replace_dest := dest; lpos := vi$perform_subs (source, dest, vi$cur_line_no, scount, doglobal, query); nsubs := nsubs + scount; RETURN (lpos); ENDPROCEDURE; ! ! Called from vi$do_command to parse the rest of the command line, ! this procedure then envokes lower level routines to perform the work ! of a substitution command. ! PROCEDURE vi$do_substitute (start_line, end_line, whole_range, idx, cmd) LOCAL result_text, replace_text, hrange, ch, pos, spos, epos, lpos, source, scount, dest, query, doglobal, replace, separ; pos := MARK (NONE); POSITION (END_OF (whole_range)); epos := MARK (NONE); POSITION (pos); separ := vi$next_char (cmd, idx); vi$replace_separ := separ; source := ""; dest := ""; doglobal := 0; query := 0; LOOP IF (idx > LENGTH (cmd)) THEN vi$info ("Insufficent arguments!"); RETURN (1); ENDIF; ch := SUBSTR (cmd, idx, 1); EXITIF ch = separ; source := source + ch; idx := idx + 1; ENDLOOP; idx := idx + 1; LOOP EXITIF idx > LENGTH (cmd); ch := SUBSTR (cmd, idx, 1); EXITIF ch = separ; dest := dest + ch; idx := idx + 1; ENDLOOP; idx := idx + 1; LOOP EXITIF idx > LENGTH (cmd); ch := SUBSTR (cmd, idx, 1); IF (ch = "q") OR (ch = "c") THEN query := 1; ELSE IF ch = "g" THEN doglobal := 1; ELSE vi$info ("Unrecognized command qualifier '"+ch+"'"); RETURN (1); ENDIF; ENDIF; idx := idx + 1; ENDLOOP; POSITION (pos); vi$save_for_undo (whole_range, VI$LINE_MODE, 1); vi$move_to_line (start_line); IF MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER) THEN MOVE_HORIZONTAL (-1); spos := MARK (NONE); MOVE_HORIZONTAL (1); ELSE spos := 0; ENDIF; vi$replace_source := source; vi$replace_dest := dest; scount := 0; lpos := vi$perform_subs (source, dest, end_line, scount, doglobal, query); IF (scount = 0) THEN vi$kill_undo; vi$undo_end := 0; POSITION (pos); ELSE vi$undo_end := epos; IF (spos = 0) THEN vi$undo_start := BEGINNING_OF (CURRENT_BUFFER); ELSE POSITION (spos); MOVE_HORIZONTAL (1); vi$undo_start := MARK (NONE); ENDIF; vi$pos_in_middle (lpos); vi$info (FAO ("!UL substitution!%S!", scount)); ENDIF; RETURN (1); ENDPROCEDURE; ! ! Repeat the last substitute command that was issued at the ":" prompt. ! ! The function mapped to '&'. ! PROCEDURE vi$repeat_subs LOCAL scount, doglobal, query, lpos, spos, pos, epos, here; IF (vi$replace_separ = 0) THEN vi$info ("No previous substitution!"); RETURN; ENDIF; doglobal := 0; query := 0; here := vi$cur_line_no; vi$save_for_undo (CURRENT_LINE, VI$LINE_MODE, 1); pos := MARK (NONE); POSITION (LINE_BEGIN); spos := vi$get_undo_start; POSITION (LINE_END); IF (LENGTH (CURRENT_LINE) > 0) THEN MOVE_HORIZONTAL (-1); ENDIF; epos := MARK (NONE); POSITION (pos); lpos := vi$perform_subs (vi$replace_source, vi$replace_dest, here, scount, doglobal, query); IF (scount = 0) THEN vi$kill_undo; vi$undo_end := 0; ELSE vi$undo_end := epos; vi$undo_start := vi$set_undo_start (spos); POSITION (lpos); ENDIF; RETURN (lpos); ENDPROCEDURE; ! ! Perform a substitution from the current location to "end_line". ! Use source as the search string, and dest as the substitution ! spec. "global" indicates whether or not all occurances on a line ! are examined, and "query" indicates whether or not to prompt before ! performing the substitution. On return, "scount" will hold the ! number of substitutions actually performed. ! PROCEDURE vi$perform_subs (source, dest, end_line, scount, doglobal, query) LOCAL result_text, replace_text, answer, fcnt, lpos, hrange, replace, fpos, quit_now, cwin, pos; SET (FORWARD, CURRENT_BUFFER); scount := 0; fcnt := 0; quit_now := 0; pos := MARK (NONE); LOOP fpos := vi$find_str (source, 1, 1); EXITIF (fpos = 0); fcnt := fcnt + 1; POSITION (BEGINNING_OF (fpos)); IF vi$cur_line_no > end_line THEN POSITION (pos); EXITIF (1); ENDIF; result_text := SUBSTR (fpos, 1, LENGTH (fpos)); replace_text := vi$substitution (result_text, dest); POSITION (BEGINNING_OF (fpos)); replace := 1; IF (query) THEN POSITION (BEGINNING_OF (fpos)); hrange := CREATE_RANGE (BEGINNING_OF (fpos), END_OF (fpos), REVERSE); cwin := GET_INFO (WINDOWS, "FIRST"); LOOP EXITIF (cwin = 0); IF (GET_INFO (cwin, "VISIBLE")) THEN UPDATE (cwin); ENDIF; cwin := GET_INFO (WINDOWS, "NEXT"); ENDLOOP; answer := vi$read_line ("Replace y/n/a/q? "); CHANGE_CASE (answer, LOWER); IF (answer = "") OR (INDEX ("yes", answer) <> 1) THEN replace := 0; ENDIF; IF (INDEX ("quit", answer) = 1) THEN quit_now := 1; ENDIF; IF (INDEX ("all", answer) = 1) THEN query := 0; replace := 1; ENDIF; ENDIF; IF replace THEN ! This is a hack necessary to fix TPU's pattern matching. ! The length of the text matched by only "line_begin" and ! "line_end" has length == 1 instead of 0 as one would expect. IF (source <> "^") AND (source <> "$") AND (source <> "") THEN ERASE_CHARACTER (LENGTH (result_text)); ENDIF; COPY_TEXT (replace_text); pos := MARK (NONE); scount := scount + 1; ELSE MOVE_HORIZONTAL (1); ENDIF; IF NOT doglobal THEN POSITION (LINE_BEGIN); EXITIF MARK (NONE) = END_OF (CURRENT_BUFFER); MOVE_VERTICAL (1); ENDIF; EXITIF quit_now; ENDLOOP; IF fcnt = 0 THEN vi$info ("string not found!"); ENDIF; RETURN (pos); ENDPROCEDURE; ! ! Move horizontal, ignoring errors ! PROCEDURE vi$move_horizontal (cnt) ON_ERROR ENDON_ERROR; MOVE_HORIZONTAL (cnt); ENDPROCEDURE; ! ! Move vertical, ignoring errors ! PROCEDURE vi$move_vertical (cnt) ON_ERROR ENDON_ERROR; MOVE_VERTICAL (cnt); ENDPROCEDURE; ! ! Move to the indicated line number. ! PROCEDURE vi$move_to_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 (MARK (NONE)); ENDPROCEDURE; ! ! Give a source string, and a "dest" substitution spec, perform the ! RE style substitution, and return the resultant string. ! PROCEDURE vi$substitution (source, dest) LOCAL cur_char, result, idx; idx := 0; result := ""; LOOP EXITIF (idx > LENGTH(dest)); cur_char := SUBSTR (dest, idx, 1); IF (cur_char = "&") THEN result := result + source; idx := idx + 1; ELSE IF (cur_char = '\') THEN cur_char := SUBSTR(dest, idx+1, 1); IF (INDEX ("123456789", cur_char) > 0) THEN vi$global_var := 0; IF INT(cur_char) > 1 THEN EXECUTE (COMPILE ("vi$global_var := SUBSTR (p" + cur_char +", LENGTH (o"+cur_char+")+1,512);")); ELSE EXECUTE (COMPILE ("vi$global_var := SUBSTR (p" + cur_char +", LENGTH (o"+cur_char+"),512);")); ENDIF; result := result + vi$global_var; ELSE IF (cur_char = "&") THEN result := result + cur_char; ELSE result := result + "\" + cur_char; ENDIF; ENDIF; idx := idx + 2; ELSE result := result + cur_char; idx := idx + 1; ENDIF; ENDIF; ENDLOOP; RETURN (result); ENDPROCEDURE; ! ! Get the next character from a string at idx, and point past the character ! PROCEDURE vi$next_char (cmd, idx) IF idx <= LENGTH (cmd) THEN idx := idx + 1; RETURN (SUBSTR (cmd, idx -1, 1)); ENDIF; RETURN (""); ENDPROCEDURE; ! ! Process all set commands in the string cmd ! PROCEDURE vi$set_commands (cmd, i) LOCAL err, separ, token_1; ON_ERROR RETURN; ENDON_ERROR; LOOP token_1 := vi$skip_separ (cmd, i, "= "+ASCII(9), separ); EDIT (token_1, COLLAPSE); EXITIF token_1 = ""; err := vi$set_one (token_1, separ, cmd, i); EXITIF err; ENDLOOP; RETURN (err); ENDPROCEDURE ! ! Process a single set command and return success or failure. ! PROCEDURE vi$set_one (token_1, separ, cmd, i) LOCAL val, errno, curwin, curbuf, buf, use_fortran, oldscrlen, npat, pstr, token_2; ON_ERROR errno := ERROR; vi$info ("ERROR at line: "+STR(ERROR_LINE)+", "+ call_user(vi$cu_getmsg,STR(errno))); RETURN (1); ENDON_ERROR; token_2 := ""; a IF (token_1 = "all") THEN vi$show_settings; RETURN (0); ENDIF; IF (token_1 = "tags") THEN vi$tag_files := vi$rest_of_line (cmd, i); i := LENGTH (cmd) + 1; RETURN (vi$load_tags); ENDIF; IF (token_1 = "notagcase") OR (token_1 = "notc") THEN vi$tag_case := NO_EXACT; RETURN (0); ENDIF; IF (token_1 = "tagcase") OR (token_1 = "tc") THEN vi$tag_case := EXACT; RETURN (0); ENDIF; IF (token_1 = "senddcl") THEN vi$send_dcl := 1; RETURN (0); ENDIF; IF (token_1 = "nosenddcl") THEN vi$send_dcl := 0; RETURN (0); ENDIF; IF (token_1 = "empty") THEN vi$delete_empty := 0; RETURN (0); ENDIF; IF (token_1 = "noempty") THEN vi$delete_empty := 1; RETURN (0); ENDIF; IF (token_1 = "files") OR (token_1 = "file") THEN val := vi$expand_file_list (vi$rest_of_line (cmd, i)); vi$info (FAO ("!UL file!%S selected", val, 0)); RETURN (2); ENDIF; IF (token_1 = "notabs") THEN vi$use_tabs := 0; RETURN (0); ENDIF; IF (token_1 = "tabs") THEN vi$use_tabs := 1; RETURN (0); ENDIF; IF (token_1 = "noreadonly") OR (token_1 = "noro") THEN SET (NO_WRITE, CURRENT_BUFFER, OFF); vi$setbufmode (CURRENT_BUFFER, 0); vi$status_lines (CURRENT_BUFFER); RETURN (0); ENDIF; IF (token_1 = "readonly") OR (token_1 = "ro") THEN vi$setbufmode (CURRENT_BUFFER, 1); vi$status_lines (CURRENT_BUFFER); RETURN (0); ENDIF; IF (token_1 = "write") OR (token_1 = "wr") THEN SET (NO_WRITE, CURRENT_BUFFER, OFF); vi$status_lines (CURRENT_BUFFER); RETURN (0); ENDIF; IF (token_1 = "nowrite") OR (token_1 = "nowr") THEN SET (NO_WRITE, CURRENT_BUFFER, ON); vi$status_lines (CURRENT_BUFFER); RETURN (0); ENDIF; IF (token_1 = "width") THEN token_2 := vi$skip_separ (cmd, i, "= "+ASCII(9), separ); val := INT (token_2); SET (WIDTH, CURRENT_WINDOW, val); vi$scr_width := val; RETURN (0); ENDIF; IF (token_1 = "window") THEN token_2 := vi$skip_separ (cmd, i, "= "+ASCII(9), separ); val := INT (token_2); RETURN (vi$do_set_window (val)); ENDIF; IF (token_1 = "ts") OR (token_1 = "tabstops") THEN token_2 := vi$skip_separ (cmd, i, "= "+ASCII(9), separ); val := INT (token_2); SET (TAB_STOPS, CURRENT_BUFFER, val); vi$tab_amount := val; RETURN (0); ENDIF; IF (token_1 = "sw") OR (token_1 = "shiftwidth") then token_2 := vi$skip_separ (cmd, i, "= "+ASCII(9), separ); vi$shift_width := INT (token_2); RETURN (0); ENDIF; IF (token_1 = "noautoindent") OR (token_1 = "noai") THEN vi$auto_indent := 0; RETURN (0); ENDIF; IF (token_1 = "autoindent") OR (token_1 = "ai") THEN vi$auto_indent := 1; RETURN (0); ENDIF; IF (token_1 = "noundomap") OR (token_1 = "noum") THEN vi$undo_map := 0; RETURN (0); ENDIF; IF (token_1 = "undomap") OR (token_1 = "um") THEN vi$undo_map := 1; RETURN (0); ENDIF; IF (token_1 = "scroll") THEN token_2 := vi$skip_separ (cmd, i, "= "+ASCII(9), separ); vi$how_much_scroll := INT (token_2); RETURN (0); ENDIF; IF (token_1 = "report") THEN token_2 := vi$skip_separ (cmd, i, "= "+ASCII(9), separ); vi$report := INT (token_2); RETURN (0); ENDIF; IF (token_1 = "aw") OR (token_1 = "autowrite") THEN vi$auto_write := 1; RETURN (0); ENDIF; IF (token_1 = "noaw") OR (token_1 = "noautowrite") THEN vi$auto_write := 0; RETURN (0); ENDIF; IF (token_1 = "noic") OR (token_1 = "noignorecase") THEN vi$ignore_case := EXACT; RETURN (0); ENDIF; IF (token_1 = "ic") OR (token_1 = "ignorecase") THEN vi$ignore_case := NO_EXACT; RETURN (0); ENDIF; IF (token_1 = "magic") THEN vi$magic := 1; RETURN (0); ENDIF; $$EOD$$