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:44:55.39
$!
$! It contains the following 1 file:
$! VI.8
$!=============================================================================
$ 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.8"
$ Check_Sum_is=1045109009
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X POSITION (pos);
X DELETE (buf);
X
X vi$message ("Key now unmapped!");
XENDPROCEDURE;
X
X!
X! Show current keyboard mappings.
X!
XPROCEDURE vi$show_maps
X LOCAL
X com,
X key_type,
X keyn,
X key,
X bpos,
X npos,
X pos,
X buf;
X
X pos := MARK (NONE);
X buf := choice_buffer;
X
X POSITION (buf);
X ERASE (buf);
X
X key_type := vi$cmd_keys;
X COPY_TEXT ("COMMAND KEY MAPS:");
X SPLIT_LINE;
X LOOP
X keyn := GET_INFO (DEFINED_KEY, "first", key_type);
X LOOP
X EXITIF (keyn = 0);
X com := LOOKUP_KEY (keyn, COMMENT, key_type);
X
X IF (com = "active_macro") THEN
X key := vi$key_map_name (keyn);
X vi$global_var := 0;
X EXECUTE (COMPILE ("vi$global_var:=vi$$key_map_buf_"+
X key+key_type));
X IF (vi$global_var <> 0) AND
X (GET_INFO (vi$global_var, "TYPE") = BUFFER) THEN
X key := vi$ascii_name (keyn);
X COPY_TEXT (" "+key+SUBSTR (" ", 1, 4-LENGTH(key))+'"');
X npos := MARK (NONE);
X POSITION (BEGINNING_OF (vi$global_var));
X LOOP
X keyn := CURRENT_LINE;
X EXITIF (LENGTH (keyn) < 8);
X bpos := MARK (NONE);
X POSITION (npos);
X COPY_TEXT (vi$ascii_name (INT(keyn)));
X POSITION (bpos);
X MOVE_VERTICAL (1);
X ENDLOOP;
X POSITION (npos);
X COPY_TEXT ('"');
X SPLIT_LINE;
X ENDIF;
X ENDIF;
X keyn := GET_INFO (DEFINED_KEY, "next", key_type);
X ENDLOOP;
X EXITIF (key_type = vi$edit_keys);
X key_type := vi$edit_keys;
X SPLIT_LINE;
X COPY_TEXT ("EDITING KEY MAPS:");
X SPLIT_LINE;
X ENDLOOP;
X
X APPEND_LINE;
X POSITION (BEGINNING_OF (buf));
X POSITION (pos);
X vi$show_list (buf,
X " Current MAPPINGS" +
X " ",
X info_window);
X RETURN (0);
X
XENDPROCEDURE;
X
X!
X! Generate a unique string based on a KEY_NAME value.
X!
XPROCEDURE vi$key_map_name (key)
X RETURN (SUBSTR(FAO("!XL", key),1,6));
XENDPROCEDURE;
X
X!
X! Increment "i" until it is no longer indexing a blank or tab in "cmd".
X!
XPROCEDURE vi$skip_white (cmd, i)
X
X LOOP
X EXITIF i > LENGTH (cmd);
X EXITIF (INDEX (" ", SUBSTR(cmd, i, 1)) = 0);
X i := i + 1;
X ENDLOOP;
XENDPROCEDURE;
X
X!
X! Given a string, extract a line specification that is either absolute,
X! relative, or an RE pattern expression.
X!
XPROCEDURE vi$get_line_spec (idx, cmd)
X LOCAL
X ch,
X sch,
X num;
X
X num := -1;
X
X ch := SUBSTR (cmd, idx, 1);
X
X IF (ch = "/") OR (ch = "?") THEN
X idx := idx + 1;
X sch := ch;
X num := "";
X LOOP
X EXITIF (vi$parse_next_ch (idx, cmd, sch));
X EXITIF (LENGTH (cmd) < idx);
X ch := SUBSTR (cmd, idx, 1);
X IF (ch = "\") THEN
X num := num + SUBSTR (cmd, idx, 2);
X idx := idx + 1;
X ELSE
X num := num + ch;
X ENDIF;
X idx := idx + 1;
X ENDLOOP;
X
X IF (LENGTH (cmd) < idx - 1) THEN
X MESSAGE ("Oops, improper expression!");
X RETURN (-1);
X ENDIF;
X
X ch := SUBSTR (cmd, idx, 1);
X
X IF sch = "?" THEN
X SET (REVERSE, CURRENT_BUFFER);
X ELSE
X SET (FORWARD, CURRENT_BUFFER);
X ENDIF;
X
X num := vi$find_str (num, 0);
X
X IF (num <> 0) THEN
X num := BEGINNING_OF (num);
X POSITION (num);
X num := vi$cur_line_no;
X ELSE
X num := -1;
X ENDIF;
X ELSE
X LOOP
X ch := SUBSTR (cmd, idx, 1);
X EXITIF (INDEX (vi$_numeric_chars, ch) = 0);
X IF (num < 0) THEN
X num := INT (ch);
X ELSE
X num := num * 10 + INT (ch);
X ENDIF;
X idx := idx + 1;
X ENDLOOP;
X ENDIF;
X
X IF (ch = ".") THEN
X num := vi$cur_line_no;
X idx := idx + 1;
X IF (vi$parse_next_ch (idx, cmd, "+")) THEN
X num := num + vi$get_line_spec (idx, cmd);
X ENDIF;
X ELSE
X IF (ch = "$") THEN
X num := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
X idx := idx + 1;
X ELSE
X IF (ch = "+") THEN
X num := num + vi$get_line_spec (idx, cmd);
X ENDIF;
X ENDIF;
X ENDIF;
X
X RETURN (num);
XENDPROCEDURE;
X
X!
X! If the character at location "idx" in "cmd" is "try", then increment
X! "idx" and return TRUE, otherwise return FALSE.
X!
XPROCEDURE vi$parse_next_ch (idx, cmd, try)
X IF (SUBSTR (cmd, idx, 1) = try) THEN
X idx := idx + 1;
X RETURN (1);
X ENDIF;
X
X RETURN (0);
XENDPROCEDURE;
X
X!
X! A function to get the string, in "cmd", that is spanned by the characters
X! in "mask". "idx" is incremented to point past this string, and the string
X! is returned as the function value.
X!
XPROCEDURE vi$get_cmd_token (mask, cmd, idx)
X LOCAL
X token,
X ch;
X
X token := "";
X
X vi$skip_white (cmd, idx);
X
X LOOP
X EXITIF (idx > LENGTH (cmd));
X ch := SUBSTR (cmd, idx, 1);
X EXITIF (INDEX (mask, ch) = 0);
X token := token + ch;
X idx := idx + 1;
X ENDLOOP;
X
X RETURN (token);
XENDPROCEDURE;
X
X!
X! A function to see if the string "token" is a lead substring of "cmd".
X!
XPROCEDURE vi$leading_str (token, cmd)
X RETURN ((token <> "") AND (INDEX (cmd, token) = 1));
XENDPROCEDURE;
X
X!
X! A routine that looks for the first occurance of a character in
X! "seps", in "cmd", and then changes "idx" to reflect that locatation.
X! "separ" will contain the character in "seps" that was actually found.
X!
XPROCEDURE vi$skip_separ (cmd, idx, seps, separ)
X LOCAL
X nch,
X retstr;
X
X retstr := "";
X separ := "";
X vi$skip_white (cmd, idx);
X
X LOOP
X EXITIF (idx > LENGTH (cmd));
X nch := SUBSTR (cmd, idx, 1);
X idx := idx + 1;
X IF (INDEX (seps, nch) <> 0) OR (nch = " ") OR (nch = " ") THEN
X separ := nch;
X RETURN (retstr);
X ENDIF;
X retstr := retstr + nch;
X ENDLOOP;
X RETURN (retstr);
XENDPROCEDURE;
X
X!
X! A procedure that returns the characters occuring at index, "idx", and
X! after in the string "cmd".
X!
XPROCEDURE vi$rest_of_line (cmd, idx)
X RETURN (SUBSTR (cmd, idx, LENGTH (cmd)-idx + 1));
XENDPROCEDURE;
X
X!
X! SET (INFORMATIONAL/SUCCESS) short procedures.
X!
XPROCEDURE vi$info_success_off vi$info_off; vi$success_off; ENDPROCEDURE;
XPROCEDURE vi$info_success_on vi$info_on; vi$success_on; ENDPROCEDURE;
XPROCEDURE vi$success_off SET (SUCCESS, OFF); ENDPROCEDURE;
XPROCEDURE vi$success_on SET (SUCCESS, ON); ENDPROCEDURE;
XPROCEDURE vi$info_off SET (INFORMATIONAL, OFF); ENDPROCEDURE;
XPROCEDURE vi$info_on SET (INFORMATIONAL, ON); ENDPROCEDURE;
X
X!
V! Called from vi$do_global to perform a substitution during a global command
X.
X!
XPROCEDURE vi$global_subs (cmd, nsubs)
X
X LOCAL
X idx,
X result_text,
X replace_text,
X hrange,
X ch,
X pos,
X spos,
X epos,
X lpos,
X source,
X scount,
X dest,
X query,
X global,
X replace,
X separ;
X
X idx := 1;
X
X separ := vi$next_char (cmd, idx);
X
X source := "";
X dest := "";
X global := 0;
X query := 0;
X
X LOOP
X IF (idx > LENGTH (cmd)) THEN
X vi$message ("Insufficent arguments!");
X RETURN (0);
X ENDIF;
X
X ch := SUBSTR (cmd, idx, 1);
X EXITIF ch = separ;
X source := source + ch;
X idx := idx + 1;
X ENDLOOP;
X
X idx := idx + 1;
X LOOP
X EXITIF idx > LENGTH (cmd);
X ch := SUBSTR (cmd, idx, 1);
X EXITIF ch = separ;
X dest := dest + ch;
X idx := idx + 1;
X ENDLOOP;
X
X idx := idx + 1;
X LOOP
X EXITIF idx > LENGTH (cmd);
X ch := SUBSTR (cmd, idx, 1);
X IF ch = "q" THEN
X query := 1;
X ELSE
X IF ch = "g" THEN
X global := 1;
X ELSE
X vi$message ("Unrecognized command qualifier '"+ch+"'");
X RETURN (0);
X ENDIF;
X ENDIF;
X idx := idx + 1;
X ENDLOOP;
X
X vi$replace_source := source;
X vi$replace_dest := dest;
X
X lpos := vi$perform_subs (source, dest, vi$cur_line_no,
X scount, global, query);
X nsubs := nsubs + scount;
X
X RETURN (lpos);
XENDPROCEDURE;
X!
X! Called from vi$do_command to parse the rest of the command line,
X! this procedure then envokes lower level routines to perform the work
X! of a substitution command.
X!
XPROCEDURE vi$do_substitute (start_line, end_line, whole_range, idx, cmd)
X
X LOCAL
X result_text,
X replace_text,
X hrange,
X ch,
X pos,
X spos,
X epos,
X lpos,
X source,
X scount,
X dest,
X query,
X global,
X replace,
X separ;
X
X pos := MARK (NONE);
X POSITION (END_OF (whole_range));
X epos := MARK (NONE);
X POSITION (pos);
X
X separ := vi$next_char (cmd, idx);
X vi$replace_separ := separ;
X
X source := "";
X dest := "";
X global := 0;
X query := 0;
X
X MESSAGE ("");
X LOOP
X IF (idx > LENGTH (cmd)) THEN
X vi$message ("Insufficent arguments!");
X RETURN (1);
X ENDIF;
X
X ch := SUBSTR (cmd, idx, 1);
X EXITIF ch = separ;
X source := source + ch;
X idx := idx + 1;
X ENDLOOP;
X
X idx := idx + 1;
X LOOP
X EXITIF idx > LENGTH (cmd);
X ch := SUBSTR (cmd, idx, 1);
X EXITIF ch = separ;
X dest := dest + ch;
X idx := idx + 1;
X ENDLOOP;
X
X idx := idx + 1;
X LOOP
X EXITIF idx > LENGTH (cmd);
X ch := SUBSTR (cmd, idx, 1);
X IF ch = "q" THEN
X query := 1;
X ELSE
X IF ch = "g" THEN
X global := 1;
X ELSE
X vi$message ("Unrecognized command qualifier '"+ch+"'");
X RETURN (1);
X ENDIF;
X ENDIF;
X idx := idx + 1;
X ENDLOOP;
X
X POSITION (pos);
X vi$save_for_undo (whole_range, VI$LINE_MODE, 1);
X vi$move_to_line (start_line);
X
X IF MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER) THEN
X MOVE_HORIZONTAL (-1);
X spos := MARK (NONE);
X MOVE_HORIZONTAL (1);
X ELSE
X spos := 0;
X ENDIF;
X
X vi$replace_source := source;
X vi$replace_dest := dest;
X
X lpos := vi$perform_subs (source, dest, end_line, scount, global, query);
X
X IF (scount = 0) THEN
X vi$kill_undo;
X vi$undo_end := 0;
X POSITION (pos);
X ELSE
X vi$undo_end := epos;
X IF (spos = 0) THEN
X vi$undo_start := BEGINNING_OF (CURRENT_BUFFER);
X ELSE
X POSITION (spos);
X MOVE_HORIZONTAL (1);
X vi$undo_start := MARK (NONE);
X ENDIF;
X vi$pos_in_middle (lpos);
X MESSAGE (FAO ("!UL substitution!%S!", scount));
X ENDIF;
X
X RETURN (1);
XENDPROCEDURE;
X
X!
X! Repeat the last substitute command that was issued at the ":" prompt.
X!
X! The function mapped to '&'.
X!
XPROCEDURE vi$repeat_subs
X LOCAL
X scount,
X global,
X query,
X lpos,
X spos,
X pos,
X epos,
X here;
X
X IF (vi$replace_separ = 0) THEN
X vi$message ("No previous substitution!");
X RETURN;
X ENDIF;
X
X global := 0;
X query := 0;
X here := vi$cur_line_no;
X vi$save_for_undo (CURRENT_LINE, VI$LINE_MODE, 1);
X
X pos := MARK (NONE);
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X
X spos := vi$get_undo_start;
X
X MOVE_HORIZONTAL (LENGTH (CURRENT_LINE));
X IF (LENGTH (CURRENT_LINE) > 0) THEN
X MOVE_HORIZONTAL (-1);
X ENDIF;
X epos := MARK (NONE);
X POSITION (pos);
X
X lpos := vi$perform_subs (vi$replace_source, vi$replace_dest,
X here, scount, global, query);
X
X IF (scount = 0) THEN
X vi$kill_undo;
X vi$undo_end := 0;
X ELSE
X vi$undo_end := epos;
X vi$undo_start := vi$set_undo_start (spos);
X POSITION (lpos);
X ENDIF;
X
XENDPROCEDURE;
X
X!
X! Perform a substitution from the current location to "end_line".
X! Use source as the search string, and dest as the substitution
X! spec. "global" indicates whether or not all occurances on a line
X! are examined, and "query" indicates whether or not to prompt before
X! performing the substitution. On return, "scount" will hold the
X! number of substitutions actually performed.
X!
XPROCEDURE vi$perform_subs (source, dest, end_line, scount, global, query)
X
X LOCAL
X result_text,
X replace_text,
X answer,
X fcnt,
X lpos,
X hrange,
X replace,
X fpos,
X quit_now,
X cwin,
X pos;
X
X SET (FORWARD, CURRENT_BUFFER);
X scount := 0;
X fcnt := 0;
X quit_now := 0;
X pos := MARK (NONE);
X
X LOOP
X fpos := vi$find_str (source, 1);
X EXITIF (fpos = 0);
X fcnt := fcnt + 1;
X POSITION (BEGINNING_OF (fpos));
X
X IF vi$cur_line_no > end_line THEN
X POSITION (pos);
X EXITIF (1);
X ENDIF;
X result_text := SUBSTR (fpos, 1, LENGTH (fpos));
X replace_text := vi$substitution (result_text, dest);
X POSITION (BEGINNING_OF (fpos));
X
X replace := 1;
X IF (query) THEN
X POSITION (BEGINNING_OF (fpos));
X hrange := CREATE_RANGE (BEGINNING_OF (fpos),
X END_OF (fpos), REVERSE);
X cwin := GET_INFO (WINDOWS, "FIRST");
X LOOP
X EXITIF (cwin = 0);
X IF (GET_INFO (cwin, "VISIBLE")) THEN
X UPDATE (cwin);
X ENDIF;
X cwin := GET_INFO (WINDOWS, "NEXT");
X ENDLOOP;
X
X answer := vi$read_line ("Replace y/n/a/q? ");
X
X CHANGE_CASE (answer, LOWER);
X IF (answer = "") OR (INDEX ("yes", answer) <> 1) THEN
X replace := 0;
X ENDIF;
X IF (INDEX ("quit", answer) = 1) THEN
X quit_now := 1;
X ENDIF;
X IF (INDEX ("all", answer) = 1) THEN
X query := 0;
X ENDIF;
X ENDIF;
X
X IF replace THEN
X
X! This is a hack necessary to fix TPU's pattern matching.
X! The length of the text match by only "line_begin" has
X! length == 1 instead of 0 as one would expect.
X
X IF (source <> "^") THEN
X ERASE_CHARACTER (LENGTH (result_text));
X ENDIF;
X COPY_TEXT (replace_text);
X pos := MARK (NONE);
X scount := scount + 1;
X ELSE
X MOVE_HORIZONTAL (1);
X ENDIF;
X
X IF NOT global THEN
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X EXITIF MARK (NONE) = END_OF (CURRENT_BUFFER);
X MOVE_VERTICAL (1);
X ENDIF;
X EXITIF quit_now;
X ENDLOOP;
X
X IF fcnt = 0 THEN
X MESSAGE ("string not found!");
X ENDIF;
X
X RETURN (pos);
XENDPROCEDURE;
X
X!
X! Move horizontal, ignoring errors
X!
XPROCEDURE vi$move_horizontal (cnt)
X ON_ERROR
X ENDON_ERROR;
X
X MOVE_HORIZONTAL (cnt);
XENDPROCEDURE;
X
X!
X! Move vertical, ignoring errors
X!
XPROCEDURE vi$move_vertical (cnt)
X ON_ERROR
X ENDON_ERROR;
X
X MOVE_VERTICAL (cnt);
XENDPROCEDURE;
X
X!
X! Move to the indicated line number.
X!
XPROCEDURE vi$move_to_line (line_no)
X LOCAL
X pos;
X
X ON_ERROR
X POSITION (pos);
X RETURN (0);
X ENDON_ERROR;
X
X pos := MARK (NONE);
X POSITION (BEGINNING_OF (CURRENT_BUFFER));
X MOVE_VERTICAL (line_no - 1);
X
X RETURN (MARK (NONE));
XENDPROCEDURE;
X
X!
X! Give a source string, and a "dest" substitution spec, perform the
X! RE style substitution, and return the resultant string.
X!
XPROCEDURE vi$substitution (source, dest)
X
X LOCAL
X cur_char,
X result,
X idx;
X
X idx := 0;
X result := "";
X
X LOOP
X EXITIF (idx > LENGTH(dest));
X
X cur_char := SUBSTR (dest, idx, 1);
X IF (cur_char = "&") THEN
X result := result + source;
X idx := idx + 1;
X ELSE
X IF (cur_char = '\') THEN
X cur_char := SUBSTR(dest, idx+1, 1);
X IF (INDEX ("123456789", cur_char) > 0) THEN
X IF INT(cur_char) > 1 THEN
X EXECUTE (COMPILE ("vi$glo_str := SUBSTR (p" +
X cur_char +", LENGTH (o"+cur_char+")+1,512);"));
X ELSE
X EXECUTE (COMPILE ("vi$glo_str := SUBSTR (p" +
X cur_char +", LENGTH (o"+cur_char+"),512);"));
X ENDIF;
X result := result + vi$glo_str;
X ELSE
X result := result + "\" + cur_char;
X ENDIF;
X idx := idx + 2;
X ELSE
X result := result + cur_char;
X idx := idx + 1;
X ENDIF;
X ENDIF;
X ENDLOOP;
X
X RETURN (result);
XENDPROCEDURE;
X
X!
X! Get the next character from a string at idx, and point past the character
X!
XPROCEDURE vi$next_char (cmd, idx)
X
X IF idx <= LENGTH (cmd) THEN
X idx := idx + 1;
X RETURN (SUBSTR (cmd, idx -1, 1));
X ENDIF;
X
X RETURN ("");
XENDPROCEDURE;
X
X!
X! Process all set commands in the string cmd
X!
XPROCEDURE vi$set_commands (cmd, i)
X LOCAL
X err,
X separ,
X token_1;
X
X ON_ERROR
X RETURN;
X ENDON_ERROR;
X
X LOOP
X token_1 := vi$skip_separ (cmd, i, "= ", separ);
X EDIT (token_1, COLLAPSE);
X
X EXITIF token_1 = "";
X
X err := vi$set_one (token_1, separ, cmd, i);
X EXITIF err;
X ENDLOOP;
X RETURN (err);
XENDPROCEDURE
X
X!
X! Process a single set command and return success or failure.
X!
XPROCEDURE vi$set_one (token_1, separ, cmd, i)
X
X LOCAL
X val,
X errno,
X curwin,
X curbuf,
X buf,
X use_fortran,
X oldscrlen,
X npat,
X pstr,
X token_2;
X
X ON_ERROR
X errno := ERROR;
X MESSAGE ("ERROR at line: "+STR(ERROR_LINE)+", "+
X call_user(vi$cu_getmsg,STR(errno)));
X RETURN (1);
X ENDON_ERROR;
X
X token_2 := "";
X
X IF (token_1 = "all") THEN
X vi$show_settings;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "tags") THEN
X vi$tag_files := vi$rest_of_line (cmd, i);
X i := LENGTH (cmd) + 1;
X RETURN (vi$load_tags);
X ENDIF;
X
X IF (token_1 = "notagcase") OR (token_1 = "notc") THEN
X vi$tag_case := NO_EXACT;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "tagcase") OR (token_1 = "tc") THEN
X vi$tag_case := EXACT;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "senddcl") THEN
X vi$send_dcl := 1;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "nosenddcl") THEN
X vi$send_dcl := 0;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "files") OR (token_1 = "file") THEN
X val := vi$expand_file_list (vi$rest_of_line (cmd, i));
X MESSAGE (FAO ("!UL file!%S selected", val, 0));
X RETURN (2);
X ENDIF;
X
X IF (token_1 = "notabs") THEN
X vi$use_tabs := 0;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "tabs") THEN
X vi$use_tabs := 1;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "write") OR (token_1 = "wr") THEN
X SET (NO_WRITE, CURRENT_BUFFER, OFF);
X vi$status_lines (CURRENT_BUFFER);
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "nowrite") OR (token_1 = "nowr") THEN
X SET (NO_WRITE, CURRENT_BUFFER, ON);
X vi$status_lines (CURRENT_BUFFER);
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "width") THEN
X token_2 := vi$skip_separ (cmd, i, "= ", separ);
X val := INT (token_2);
X SET (WIDTH, CURRENT_WINDOW, val);
X vi$scr_width := val;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "window") THEN
X token_2 := vi$skip_separ (cmd, i, "= ", separ);
X val := INT (token_2);
X RETURN (vi$do_set_window (val));
X ENDIF;
X
X IF (token_1 = "ts") OR (token_1 = "tabstops") THEN
X token_2 := vi$skip_separ (cmd, i, "= ", separ);
X val := INT (token_2);
X SET (TAB_STOPS, CURRENT_BUFFER, val);
X vi$tab_amount := val;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "sw") OR (token_1 = "shiftwidth") then
X token_2 := vi$skip_separ (cmd, i, "= ", separ);
X vi$shift_width := INT (token_2);
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "noundomap") OR (token_1 = "noum") THEN
X vi$undo_map := 0;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "undomap") OR (token_1 = "um") THEN
X vi$undo_map := 1;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "scroll") THEN
X token_2 := vi$skip_separ (cmd, i, "= ", separ);
X vi$how_much_scroll := INT (token_2);
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "report") THEN
X token_2 := vi$skip_separ (cmd, i, "= ", separ);
X vi$report := INT (token_2);
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "aw") OR (token_1 = "autowrite") THEN
X vi$auto_write := 1;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "noaw") OR (token_1 = "noautowrite") THEN
X vi$auto_write := 0;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "noic") OR (token_1 = "noignorecase") THEN
X vi$ignore_case := EXACT;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "ic") OR (token_1 = "ignorecase") THEN
X vi$ignore_case := NO_EXACT;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "magic") THEN
X vi$magic := 1;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "nomagic") THEN
X vi$magic := 0;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "noerrorbells") OR (token_1 = "noeb") THEN
X vi$error_bells := 0;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "errorbells") OR (token_1 = "eb") THEN
X vi$error_bells := 1;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "nowrapscan") OR (token_1 = "nows") THEN
X vi$wrap_scan := 0;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "wrapscan") OR (token_1 = "ws") THEN
X vi$wrap_scan := 1;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "noupdate") THEN
X vi$min_update := 1;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "update") THEN
X vi$min_update := 0;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "noshowmode") OR (token_1 = "nosm") THEN
X vi$show_mode := 0;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "showmode") OR (token_1 = "sm") THEN
X vi$show_mode := 1;
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "wrapmargin") OR (token_1 = "wm") THEN
X token_2 := vi$skip_separ (cmd, i, "= ", separ);
X vi$wrap_margin := INT (token_2);
X RETURN (0);
X ENDIF;
X
X vi$para_str := "P p ";
X vi$para_pat := line_begin & (
X (".P" | ".p") |
X (LINE_END));
X IF (token_1 = "sections") OR (token_1 = "sect") THEN
X pstr := "LINE_BEGIN&(";
X use_fortran := 0;
X vi$sect_str := "";
X LOOP
X EXITIF (SUBSTR (cmd, i, 1) = " ") OR (i >= LENGTH (cmd));
X npat := SUBSTR (cmd, i, 2);
X vi$sect_str := vi$sect_str + npat;
X EDIT (npat, COLLAPSE);
X IF (npat = "+c") OR (npat = "+C") THEN
X pstr := pstr + '"{"';
X ELSE
X IF (npat = "+f") OR (npat = "+F") THEN
X use_fortran := 1;
X npat := "";
X ELSE
X IF (npat = "+t") OR (npat = "+T") THEN
X pstr := pstr + '"PROCEDURE"';
X ELSE
X pstr := pstr + '".' + npat + '"';
X ENDIF;
X ENDIF;
X ENDIF;
X i := i + 2;
X EXITIF (SUBSTR (cmd, i, 1) = " ") OR (i >= LENGTH (cmd));
X IF (npat <> "") THEN
X pstr := pstr + "|";
X ENDIF;
X ENDLOOP;
X pstr := pstr + ")";
X IF (use_fortran) THEN
X pstr := '""&(("FUNCTION"|"SUBROUTINE")|('+ pstr + "))";
X ELSE
X pstr := '""&'+pstr;
X ENDIF;
X EXECUTE (COMPILE ("vi$sect_pat:="+pstr+";"));
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "paragraphs") OR (token_1 = "para") THEN
X pstr := '""&LINE_BEGIN&(';
X vi$para_str := "";
X LOOP
X EXITIF (SUBSTR (cmd, i, 1) = " ") OR (i >= LENGTH (cmd));
X npat := SUBSTR (cmd, i, 2);
X vi$para_str := vi$para_str + npat;
X EDIT (npat, COLLAPSE);
X pstr := pstr + '".' + npat + '"';
X i := i + 2;
X EXITIF (SUBSTR (cmd, i, 1) = " ") OR (i >= LENGTH (cmd));
X IF (npat <> "") THEN
X pstr := pstr + "|";
X ENDIF;
X ENDLOOP;
X pstr := pstr + ")";
X EXECUTE (COMPILE ("vi$para_pat:="+pstr+";"));
X RETURN (0);
X ENDIF;
X
X IF (token_1 = "number") OR
X (token_1 = "optimize") OR
X (token_1 = "autoindent") OR
X (token_1 = "noautoprint") OR
X (token_1 = "novice") OR
X (token_1 = "slowopen") OR
X (token_1 = "beautify") OR
X (token_1 = "taglength") OR
X (token_1 = "directory") OR
X (token_1 = "noprompt") OR
X (token_1 = "edcompatible") OR
X (token_1 = "term") OR
X (token_1 = "noredraw") OR
X (token_1 = "terse") OR
X (token_1 = "flash") OR
X (token_1 = "noremap") OR
X (token_1 = "timeout") OR
X (token_1 = "hardtabs") OR
X (token_1 = "ttytype") OR
X (token_1 = "warn") OR
X (token_1 = "nowarn") OR
X (token_1 = "lisp") OR
X (token_1 = "list") OR
X (token_1 = "shell") OR
X (token_1 = "mesg") OR
X (token_1 = "nomesg") OR
X (token_1 = "showmatch") THEN
X vi$not_implemented (token_1);
X RETURN (1);
X ENDIF;
X
X vi$message ("Unrecognized option, use `set all' to see options.");
X RETURN (1);
X
XENDPROCEDURE;
X
X!
X! Set the window length to the integer value passed.
X!
XPROCEDURE vi$do_set_window (len)
X LOCAL
X buf,
X curwin,
X curbuf;
X
X curwin := CURRENT_WINDOW;
X curbuf := CURRENT_BUFFER;
X
X IF (vi$prev_win (curwin) = 0) AND (vi$next_win (curwin) = 0)
X AND (NOT vi$in_occlusion) THEN
X IF len < 3 THEN
X len := 3;
X ENDIF;
X
X IF len > GET_INFO (SCREEN, "VISIBLE_LENGTH") THEN
X len := GET_INFO (SCREEN, "VISIBLE_LENGTH");
X ENDIF;
X
X oldscrlen := vi$scr_length;
X vi$scr_length := len;
X
X ADJUST_WINDOW (curwin, 0, vi$scr_length - oldscrlen);
X
X buf := GET_INFO (message_window, "BUFFER");
X UNMAP (message_window);
X DELETE (message_window);
X message_window := CREATE_WINDOW (vi$scr_length - 1, 2, ON);
X MAP (message_window, buf);
X SET (STATUS_LINE, message_window, NONE, "");
X ADJUST_WINDOW (message_window, 1, 0);
X
X DELETE (command_window);
X command_window := CREATE_WINDOW (vi$scr_length, 1, OFF);
X
X buf := GET_INFO (info_window, "BUFFER");
X DELETE (info_window);
X info_window := CREATE_WINDOW (1, vi$scr_length - 1, ON);
X SET (STATUS_LINE, info_window, NONE, "");
X
X SET (PROMPT_AREA, vi$scr_length, 1, REVERSE);
X
X POSITION (curbuf);
X POSITION (curwin);
X UNMAP (curwin);
X MAP (curwin, curbuf);
X ELSE
X MESSAGE (
X "Can't change length of screen while multiple windows visible!");
X RETURN (1);
X ENDIF;
X
X vi$how_much_scroll := vi$scr_length / 2;
X RETURN (0);
XENDPROCEDURE;
X
X!
X! Show the current settings when ":set all" is issued.
X!
XPROCEDURE vi$show_settings
X LOCAL
X obuf,
X ic,
X ostat,
X ovid,
X buf;
X
X buf := vi$init_buffer ("$$vi_set_all$$", "");
X
X ostat := GET_INFO (CURRENT_WINDOW, "STATUS_LINE");
X IF (ostat = 0) THEN
X ostat := "";
X ENDIF;
X ovid := GET_INFO (CURRENT_WINDOW, "STATUS_VIDEO");
X IF (ovid = 0) THEN
X ovid := NONE;
X ENDIF;
X SET (STATUS_LINE, CURRENT_WINDOW, NONE, "");
X SET (STATUS_LINE, CURRENT_WINDOW, REVERSE,
X " Current settings of VI options");
X SET (EOB_TEXT, buf,
X " [Hit ENTER to continue editing]");
X obuf := CURRENT_BUFFER;
X POSITION (buf);
X
X IF vi$ignore_case = EXACT THEN
X ic := 2;
X ELSE
X ic := 0;
X ENDIF;
X
X COPY_TEXT (FAO (
X "!20<wrapmargin=!UL!>!20<tabstop=!UL!>!20<!ASmagic!>!20<!ASignorecase!>",
X vi$wrap_margin, vi$tab_amount,
X SUBSTR ("no", 1, (1-vi$magic)*2),
X SUBSTR ("no", 1, ic)));
X
X SPLIT_LINE;
X
X COPY_TEXT (FAO (
X "!20<shiftwidth=!UL!>!20<scroll=!UL!>!20<report=!UL!>!20<!ASautowrite!>",
X vi$shift_width, vi$how_much_scroll, vi$report,
X SUBSTR ("no", 1, (1-vi$auto_write)*2)));
X
X SPLIT_LINE;
X
X COPY_TEXT (FAO (
X "!20<!ASwrapscan!>!20<!ASupdate!>!20<!AStabs!>!20<!ASundomap!>",
X SUBSTR ("no", 1, (1-vi$wrap_scan)*2),
X SUBSTR ("no", 1, (vi$min_update)*2),
X SUBSTR ("no", 1, (1-vi$use_tabs)*2),
X SUBSTR ("no", 1, (1-vi$undo_map)*2)
X ));
X
X SPLIT_LINE;
X
X IF vi$tag_case = EXACT THEN
X ic := 0;
X ELSE
X ic := 2;
X ENDIF;
X
X COPY_TEXT (FAO (
X "!20<!AStagcase!>!20<window=!UL!>!20<width=!UL!>tags=!AS",
X SUBSTR ("no", 1, ic),
X GET_INFO (CURRENT_WINDOW, "VISIBLE_LENGTH"),
X GET_INFO (CURRENT_WINDOW, "WIDTH"),
X vi$tag_files
X ));
X
X SPLIT_LINE;
X
X COPY_TEXT (FAO (
X "!20<!ASerrorbells!>!20<paragraphs=!AS!>!20<sections=!AS!>"+
X "!20<!ASsenddcl!>",
X SUBSTR ("no", 1, (1-vi$error_bells)*2),
X vi$para_str,
X vi$sect_str,
X SUBSTR ("no", 1, (1-vi$send_dcl)*2)
X ));
X
X SPLIT_LINE;
X
X COPY_TEXT (FAO (
X "!20<!ASshowmode!>",
X SUBSTR ("no", 1, (1-vi$show_mode)*2)
X ));
X
X SPLIT_LINE;
X
X MAP (CURRENT_WINDOW, buf);
X UPDATE (CURRENT_WINDOW);
X LOOP
X EXITIF vi$read_a_key = RET_KEY;
X ENDLOOP;
X
X SET (STATUS_LINE, CURRENT_WINDOW, NONE, "");
X SET (STATUS_LINE, CURRENT_WINDOW, ovid, ostat);
X MAP (CURRENT_WINDOW, obuf);
X POSITION (obuf);
X DELETE (buf);
XENDPROCEDURE;
X
X!
X! Function to say that a particular command is not implemented.
X!
XPROCEDURE vi$not_implemented (cmd)
X vi$message (cmd + " is not implemented!");
XENDPROCEDURE;
X
X!
X! The function mapped to 't'.
X!
XPROCEDURE vi$_to_char (char_to_find)
X LOCAL
X char_val;
X
X char_val := char_to_find;
X vi$position (vi$to_char (char_val), 0);
XENDPROCEDURE;
X
X!
X! Function performing task for 't'.
X!
XPROCEDURE vi$to_char (char_to_find)
X
X LOCAL
X act_count,
X pos,
X found;
X
X IF char_to_find = 0 THEN
X char_to_find := vi$read_char_to_find;
X ENDIF;
X
X vi$last_s_char := char_to_find;
X vi$last_s_func := "vi$to_char";
X
X pos := MARK(NONE);
X
X act_count := vi$cur_active_count;
X
X MOVE_HORIZONTAL (1);
X
X IF char_to_find <> ASCII(27) THEN
X found := 0;
X LOOP
X EXITIF (CURRENT_OFFSET >= LENGTH (vi$current_line));
X MOVE_HORIZONTAL (1);
X found := 1;
X IF (CURRENT_CHARACTER = char_to_find) THEN
X act_count := act_count - 1;
X EXITIF (act_count = 0);
X ENDIF;
X found := 0;
X ENDLOOP;
X
X IF (NOT found) THEN
X POSITION (pos);
X RETURN (0);
X ELSE
X vi$move_horizontal (-1);
X ENDIF;
X ENDIF;
X
X vi$yank_mode := VI$IN_LINE_MODE;
X RETURN (vi$retpos (pos));
X
XENDPROCEDURE;
X
X!
X! The function mapped to 'T'.
X!
XPROCEDURE vi$_back_to_char (char_to_find)
X
X LOCAL
X char_val;
X
X char_val := char_to_find;
X vi$position (vi$back_to_char (char_val), 0);
XENDPROCEDURE;
X
X!
X! Function performing task for 'T'.
X!
XPROCEDURE vi$back_to_char (char_to_find)
X
X LOCAL
X act_count,
X pos,
X found;
X
X IF char_to_find = 0 THEN
X char_to_find := vi$read_char_to_find;
X ENDIF;
X
X vi$last_s_char := char_to_find;
X vi$last_s_func := "vi$back_to_char";
X
X pos := MARK(NONE);
X
X IF (CURRENT_OFFSET = 0) THEN
X RETURN (0);
X ENDIF;
X
X vi$move_horizontal (-1);
X IF (CURRENT_CHARACTER <> char_to_find) THEN
X vi$move_horizontal (1);
X ENDIF;
X
X act_count := vi$cur_active_count;
X
X IF char_to_find <> ASCII(27) THEN
X found := 0;
X LOOP
X EXITIF (CURRENT_OFFSET = 0);
X vi$move_horizontal (-1);
X found := 1;
X IF (CURRENT_CHARACTER = char_to_find) THEN
X act_count := act_count - 1;
X EXITIF (act_count = 0);
X ENDIF;
X found := 0;
X ENDLOOP;
X
X IF (NOT found) THEN
X POSITION (pos);
X RETURN (0);
X ELSE
X MOVE_HORIZONTAL(1);
X ENDIF;
X ENDIF;
X
X vi$yank_mode := VI$IN_LINE_MODE;
X RETURN (vi$retpos (pos));
XENDPROCEDURE;
X
X!
X! The function mapped to 'f'.
X!
XPROCEDURE vi$_find_char (char_to_find)
X
X LOCAL
X char_val;
X
X char_val := char_to_find;
X vi$position (vi$find_char (char_val), 0);
XENDPROCEDURE;
X
X!
X! Function performing task for 'f'.
X!
XPROCEDURE vi$find_char (char_to_find)
X
X LOCAL
X act_count,
X pos,
X found;
X
X IF char_to_find = 0 THEN
X char_to_find := vi$read_char_to_find;
X ENDIF;
X
X vi$last_s_char := char_to_find;
X vi$last_s_func := "vi$find_char";
X
X act_count := vi$cur_active_count;
X
X IF char_to_find <> ASCII(27) THEN
X pos := MARK(NONE);
X found := 0;
X LOOP
X EXITIF (CURRENT_OFFSET >= LENGTH (vi$current_line));
X MOVE_HORIZONTAL (1);
X found := 1;
X IF (CURRENT_CHARACTER = char_to_find) THEN
X act_count := act_count - 1;
X EXITIF (act_count = 0);
X ENDIF;
X found := 0;
X ENDLOOP;
X
X IF (NOT found) THEN
X POSITION (pos);
X RETURN (0);
X ENDIF;
X ELSE
X RETURN (0);
X ENDIF;
X
X vi$yank_mode := VI$IN_LINE_MODE;
X RETURN (vi$retpos(pos));
XENDPROCEDURE;
X
X!
X! The function mapped to 'F'.
X!
XPROCEDURE vi$_back_find_char (char_to_find)
X
X LOCAL
X char_val;
X
X char_val := char_to_find;
X vi$position (vi$back_find_char (char_val), 0);
XENDPROCEDURE;
X
X!
X! Function performing task for 'F'.
X!
XPROCEDURE vi$back_find_char (char_to_find)
X
X LOCAL
X act_count,
X pos,
X found;
X
X IF char_to_find = 0 THEN
X char_to_find := vi$read_char_to_find;
X ENDIF;
X
X vi$last_s_char := char_to_find;
X vi$last_s_func := "vi$back_find_char";
X
X act_count := vi$cur_active_count;
X
X IF char_to_find <> ASCII(27) THEN
X pos := MARK(NONE);
X
X LOOP
X found := 0;
X EXITIF CURRENT_OFFSET = 0;
X vi$move_horizontal (-1);
X found := 1;
X IF (CURRENT_CHARACTER = char_to_find) THEN
X act_count := act_count - 1;
X EXITIF act_count = 0;
X ENDIF;
X ENDLOOP;
X
X IF (NOT found) THEN
X POSITION (pos);
X RETURN (0);
X ENDIF;
X ENDIF;
X
X vi$yank_mode := VI$IN_LINE_MODE;
X RETURN (vi$retpos (pos));
XENDPROCEDURE;
X
X!
X! Function to read a key, and change TAB_KEY to ASCII (9). Currently
X! used by f, F, t and T commands only.
X!
XPROCEDURE vi$read_char_to_find
X LOCAL
X rkey;
X
X rkey := vi$read_a_key;
X IF (rkey = TAB_KEY) THEN
X RETURN (ASCII (9));
X ELSE
X IF (rkey = RET_KEY) THEN
X RETURN (ASCII (13));
X ELSE
X IF (rkey = DEL_KEY) THEN
X RETURN (ASCII (8));
X ENDIF;
X ENDIF;
X ENDIF;
X RETURN (ASCII (rkey));
XENDPROCEDURE;
X!
X! The function mapped to 'G'.
X!
XPROCEDURE vi$go_to_line
X vi$position (vi$to_line (vi$active_count), 1);
X vi$pos_in_middle (MARK (NONE));
X
$ GoSub Convert_File
$ Exit