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:10.20
$!
$! It contains the following 1 file:
$! VI.7
$!=============================================================================
$ 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.7"
$ Check_Sum_is=254253636
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X RETURN (1);
X ENDIF;
X ENDIF;
X ENDLOOP;
X
X IF cmd_str <> "d" THEN
X MESSAGE (STR (nsubs) + " substitutions.");
X ENDIF;
X vi$undo_end := END_OF (CURRENT_BUFFER);
X vi$undo_start := BEGINNING_OF (CURRENT_BUFFER);
X vi$check_length (olen);
X RETURN (1);
XENDPROCEDURE;
X
X!
X! Change the current working directory to the string given. A simple
X! effort is made to translate the string given, but no other effort is
X! made to decode the actual logicals emmbeded in the string.
X!
XPROCEDURE vi$do_cd (cmd, i)
X
X LOCAL
X old_dir,
X sysdisk,
X retval,
X orig_nam,
X colon,
X directory_name;
X
X ON_ERROR
X ENDON_ERROR;
X
X
X vi$skip_white (cmd, i);
X directory_name := vi$rest_of_line (cmd, i);
X
X orig_nam := directory_name;
X directory_name := CALL_USER (vi$cu_trnlnm_proc, orig_nam);
X IF (directory_name = "") THEN
X directory_name := CALL_USER (vi$cu_trnlnm_job, orig_nam);
X IF (directory_name = "") THEN
X directory_name := CALL_USER (vi$cu_trnlnm_group, orig_nam);
X IF (directory_name = "") THEN
X directory_name := CALL_USER (vi$cu_trnlnm_sys, orig_nam);
X ENDIF;
X ENDIF;
X ENDIF;
X
X IF (directory_name = "") THEN
X directory_name := orig_nam;
X ENDIF;
X
X colon := INDEX (directory_name, ":");
X sysdisk := CALL_USER (vi$cu_trnlnm_proc, "SYS$DISK");
X
X IF (colon <> 0) THEN
X sysdisk := SUBSTR (directory_name, 1, colon);
X directory_name := SUBSTR (directory_name, colon+1, 255);
X EDIT (sysdisk, UPPER,COLLAPSE);
X retval := CALL_USER (vi$cu_set_sysdisk, sysdisk);
X ENDIF;
X
X TRANSLATE (directory_name, " ", "[]");
X EDIT (directory_name, UPPER,COLLAPSE);
X directory_name := '[' + directory_name + ']';
X old_dir := CALL_USER (vi$cu_cwd, directory_name);
X MESSAGE ("New directory is " + CALL_USER (vi$cu_trnlnm_proc, "SYS$DISK") +
X CALL_USER (vi$cu_cwd, ""));
X
X RETURN (1);
XENDPROCEDURE;
X
X!
X! The show command...
X!
XPROCEDURE vi$do_show (cmd, i)
X
X LOCAL
X act;
X
X vi$skip_white (cmd, i);
X act := vi$rest_of_line (cmd, i);
X CHANGE_CASE (act, LOWER);
X IF (vi$leading_str (act, "files")) THEN
X vi$_show_files;
X ELSE
X IF (vi$leading_str (act, "buffers")) THEN
X vi$_show_buffers;
X ELSE
X IF (vi$leading_str (act, "tags")) THEN
X vi$_show_tags;
X ENDIF;
X ENDIF;
X ENDIF;
X RETURN (0);
XENDPROCEDURE;
X
X!
X! Show the current list of abbreviations that are known
X!
XPROCEDURE vi$show_abbrevs
X LOCAL
X buf,
X loc,
X varn,
X rvar,
X i,
X idx,
X ch,
X strg,
X vars,
X errno,
X pos;
X
X ON_ERROR
X errno := ERROR;
X IF (errno <> TPU$_MULTIPLENAMES) AND
X (errno <> TPU$_STRNOTFOUND) THEN
X MESSAGE (CALL_USER (vi$cu_getmsg, STR(errno)));
X POSITION (pos);
X RETURN;
X ENDIF;
X ENDON_ERROR;
X
X pos := MARK (NONE);
X buf := choice_buffer;
X
X ERASE (buf);
X vars := EXPAND_NAME ("VI$ABBR_", VARIABLES);
X IF (vars = "") THEN
X MESSAGE ("Humm, there are not any abbreviations!");
X RETURN (1);
X ENDIF;
X POSITION (buf);
X COPY_TEXT (vars);
X POSITION (BEGINNING_OF (buf));
X LOOP
X loc := SEARCH (" ", FORWARD, EXACT);
X EXITIF loc = 0;
X POSITION (BEGINNING_OF (loc));
X ERASE_CHARACTER (1);
X SPLIT_LINE;
X ENDLOOP;
X
X POSITION (BEGINNING_OF (buf));
X
X LOOP
X EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
X
X IF (CURRENT_LINE = "VI$ABBR_") THEN
X ERASE_LINE;
X ELSE
X vi$global_var := 0;
X EXECUTE (COMPILE ("vi$global_var := "+CURRENT_LINE));
X varn := SUBSTR (CURRENT_LINE, 9, 500);
X rvar := "";
X idx := 1;
X LOOP
X EXITIF (vi$global_var = 0);
X EXITIF (idx > LENGTH (VARN));
X ch := SUBSTR (VARN, idx, 1);
X IF (ch = "_") THEN
X ch := SUBSTR (VARN, idx+1, 1);
X IF (INDEX (vi$_upper_chars+"_", ch) <> 0) THEN
X rvar := rvar + ch;
X ELSE
X EDIT (ch, LOWER);
X rvar := rvar + ch;
X ENDIF;
X idx := idx + 1;
X ELSE
X EDIT (ch, LOWER);
X rvar := rvar + ch;
X ENDIF;
X idx := idx + 1;
X ENDLOOP;
X ERASE_LINE;
X IF (vi$global_var <> 0) THEN
X strg := FAO ("!20AS = ""!AS""", rvar, vi$global_var);
X COPY_TEXT (strg);
X SPLIT_LINE;
X ENDIF;
X ENDIF;
X ENDLOOP;
X POSITION (BEGINNING_OF (buf));
X POSITION (pos);
X vi$show_list (buf,
X " Current Abbreviations" +
X " ",
X info_window);
X RETURN (0);
XENDPROCEDURE;
X
X!
X! Show the current buffers and their attributes
X!
XPROCEDURE vi$_show_buffers
X LOCAL
X mod,
X nr,
X sys,
X pos,
X buf,
X bn;
X
X buf := GET_INFO (BUFFERS, "FIRST");
X ERASE (choice_buffer);
X pos := MARK (NONE);
X POSITION (choice_buffer);
X LOOP
X LOOP
X EXITIF (buf = 0);
X EXITIF (GET_INFO (buf, "SYSTEM") = 0);
X buf := GET_INFO (BUFFERS, "NEXT");
X ENDLOOP;
X EXITIF (buf = 0);
X
X mod := "Not ";
X IF GET_INFO (buf, "MODIFIED") THEN
X mod := "";
X ENDIF;
X
X nr := "";
X IF GET_INFO (buf, "NO_WRITE") THEN
X nr := " No Write";
X ENDIF;
X
X COPY_TEXT (FAO ("Name: !20AS Lines: !5UL !ASModified!AS",
X GET_INFO (buf, "NAME"), GET_INFO (buf, "RECORD_COUNT"),
X mod, nr));
X
X SPLIT_LINE;
X
X IF GET_INFO (buf, "OUTPUT_FILE") = 0 THEN
X COPY_TEXT ("[No output file]");
X ELSE
V COPY_TEXT (FAO ("Output file: !AS",GET_INFO (buf, "OUTPUT_FILE")))
X;
X ENDIF;
X
X SPLIT_LINE;
X SPLIT_LINE;
X buf := GET_INFO (BUFFERS, "NEXT");
X ENDLOOP;
X
X POSITION (BEGINNING_OF (choice_buffer));
X POSITION (pos);
X vi$show_list (choice_buffer,
X " Current buffers and associated information" +
X " ",
X info_window);
X RETURN (0);
XENDPROCEDURE;
X
X!
X! Perform the EX mode "&" command.
X!
XPROCEDURE vi$do_subs_alias (cmd, i, start_line, end_line, whole_range)
X IF vi$replace_separ = 0 THEN
X vi$message ("No previous substitution!");
X RETURN;
X ENDIF;
X
X ! Rebuild a proper substitute command.
X
X cmd := SUBSTR (cmd, 1, i-2) + "s" +
X vi$replace_separ + vi$replace_source +
X vi$replace_separ + vi$replace_dest +
X vi$replace_separ + SUBSTR (cmd, i, 255);
X
X RETURN (vi$do_substitute (start_line, end_line, whole_range, i, cmd));
XENDPROCEDURE;
X
X!
X! Perform the EX mode "!" command.
X!
XPROCEDURE vi$do_subproc (cmd, i)
X LOCAL
X ncmd;
X
X cmd := vi$rest_of_line (cmd, i);
X IF cmd = "!" THEN
X cmd := vi$last_cmd;
X ELSE
X vi$last_cmd := cmd;
X ENDIF;
X
X IF cmd = 0 THEN
X vi$message ("No command on command line!");
X RETURN (1);
X ENDIF;
X
X IF cmd = "" THEN
X vi$message ("Use "":sh"" to get an interactive CLI");
X RETURN (1);
X ENDIF;
X
X IF (vi$process_special (cmd, ncmd)) THEN
X MESSAGE (":!"+ncmd);
X UPDATE (message_window);
X ENDIF;
X
X vi$spawn (ncmd);
X RETURN (0);
XENDPROCEDURE;
X
X!
X! This procedure looks at the characters in cmd, and translates occurances
X! of the characters % and # to the names of the current buffers file, and
X! the previously edited buffers file, respectively.
X!
XPROCEDURE vi$process_special (cmd, ncmd)
X
X LOCAL
X idx,
X redo,
X ch;
X
X ncmd := "";
X idx := 1;
X redo := 0;
X
X LOOP
X EXITIF idx > LENGTH (cmd);
X ch := SUBSTR (cmd, idx, 1);
X IF (ch = "%") THEN
X ch := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE");
X redo := 1;
X ELSE
X IF(ch = "#") THEN
X IF vi$last_mapped <> 0 THEN
X ch := GET_INFO (vi$last_mapped, "OUTPUT_FILE");
X redo := 1;
X ENDIF;
X ENDIF;
X ENDIF;
X ncmd := ncmd + ch;
X idx := idx + 1;
X ENDLOOP;
X
X RETURN (redo);
XENDPROCEDURE;
X!
X! Perform the EX mode copy command.
X!
XPROCEDURE vi$do_copy (cmd, i, whole_range, olen, start_line, end_line)
X LOCAL
X spos,
X dest;
X
X vi$skip_white (cmd, i);
X dest := vi$get_line_spec (i, cmd);
X
X IF (dest > GET_INFO (CURRENT_BUFFER, "RECORD_COUNT")) THEN
X dest := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
X ENDIF;
X
X IF ((dest < start_line) OR (dest > end_line)) AND (dest > 0) THEN
X vi$move_to_line (dest + 1);
X spos := vi$get_undo_start;
X COPY_TEXT (whole_range);
X vi$kill_undo;
X MOVE_HORIZONTAL (-1);
X vi$undo_end := MARK (NONE);
X vi$undo_start := vi$set_undo_start (spos);
X ELSE
X MESSAGE ("Error in Destination of copy!");
X RETURN (1);
X ENDIF;
X
X vi$check_length (olen);
X RETURN (1);
XENDPROCEDURE;
X
X!
X! Perform the EX mode move command.
X!
XPROCEDURE vi$do_move (cmd, i, whole_range, start_line, end_line)
X LOCAL
X dest;
X
X vi$skip_white (cmd, i);
X dest := vi$get_line_spec (i, cmd);
X
X IF (dest > GET_INFO (CURRENT_BUFFER, "RECORD_COUNT")) THEN
X dest := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
X ENDIF;
X
X IF ((dest < start_line) OR (dest > end_line)) AND (dest > 0) THEN
X vi$move_to_line (dest+1);
X vi$undo_end := 0;
X vi$kill_undo;
X MOVE_TEXT (whole_range);
X ELSE
X MESSAGE ("Destination of move within source range!");
X RETURN (1);
X ENDIF;
X RETURN (0);
XENDPROCEDURE;
X
X!
X! Perform the EX mode select command.
X!
XPROCEDURE vi$do_select
X IF vi$select_pos = 0 THEN
X vi$select_pos := SELECT (REVERSE);
X vi$message ("Selection started!");
X ELSE
X vi$select_pos := 0;
X vi$message ("Selection canceled!");
X ENDIF;
X RETURN (1);
XENDPROCEDURE;
X
X!
X! Perform the EX mode fill command.
X!
XPROCEDURE vi$do_fill (cmd, i, whole_range, olen)
X LOCAL
X separ,
X token_1,
X token_2;
X
X token_1 := vi$skip_separ (cmd, i, " ", separ);
X token_2 := vi$skip_separ (cmd, i, " ", separ);
X IF token_1 = "" THEN
X token_1 := 0;
X ELSE
X token_1 := INT (token_1);
X ENDIF;
X
X IF token_2 = "" THEN
X token_2 := 0;
X ELSE
X token_2 := INT (token_2);
X ENDIF;
X
X IF (vi$select_pos <> 0) THEN
X cmd := SELECT_RANGE;
X IF (cmd = 0) THEN
X vi$message ("Nothing selected!");
X RETURN (1);
X ENDIF;
X vi$select_pos := 0;
X vi$fill_region (token_1, token_2, cmd);
X ELSE
X vi$fill_region (token_1, token_2, whole_range);
X ENDIF;
X
X vi$check_length (olen);
X RETURN (0);
XENDPROCEDURE;
X
X!
X! Perform the EX mode upper, lower, and insert commands.
X!
XPROCEDURE vi$do_case (token_1, whole_range)
X LOCAL
X rng,
X mode,
X pos,
X cmd;
X
X IF (vi$select_pos <> 0) THEN
X rng := SELECT_RANGE;
X vi$select_pos := 0;
X mode := VI$IN_LINE_MODE;
X vi$update (CURRENT_WINDOW);
X ELSE
X rng := whole_range;
X mode := VI$LINE_MODE;
X ENDIF;
X
X cmd := UPPER;
X IF SUBSTR (token_1, 1, 1) = "l" THEN
X cmd := LOWER;
X ELSE
X IF (SUBSTR (token_1, 1, 1) = "i") THEN
X cmd := INVERT;
X ENDIF;
X ENDIF;
X
X vi$undo_start := BEGINNING_OF (rng);
X vi$undo_end := END_OF (rng);
X pos := MARK (NONE);
X POSITION (BEGINNING_OF (rng));
X vi$save_for_undo (rng, mode, 1);
X POSITION (pos);
X CHANGE_CASE (rng, cmd);
X rng := 0;
X RETURN (0);
XENDPROCEDURE;
X
X!
X! Perform the EX mode delete command.
X!
XPROCEDURE vi$do_delete (start_mark, whole_range, olen)
X POSITION (start_mark);
X IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
X MOVE_HORIZONTAL (-1);
X vi$undo_start := MARK (NONE);
X ELSE
X vi$undo_start := 0;
X ENDIF;
X
X vi$save_for_undo (whole_range, VI$LINE_MODE, 1);
X vi$undo_end := 0;
X ERASE (whole_range);
X IF (vi$undo_start <> 0) THEN
X POSITION (vi$undo_start);
X MOVE_HORIZONTAL (1);
X vi$undo_start := MARK (NONE);
X ELSE
X vi$undo_start := BEGINNING_OF (CURRENT_BUFFER);
X ENDIF;
X vi$check_length (olen);
X RETURN (0);
XENDPROCEDURE;
X
X!
X! Perform the EX mode write command.
X!
XPROCEDURE vi$do_write (cmd, i, no_spec, token_1, whole_range)
X LOCAL
X range_used,
X outf,
X res_spec,
X ncmd,
X buf,
X win,
X owin,
X bang,
X proc,
X token_2;
X
X ON_ERROR
X IF ERROR = TPU$_PARSEFAIL THEN
X MESSAGE ("Don't understand filename, '"+token_2+"'");
X RETURN (1);
X ENDIF;
X ENDON_ERROR;
X
X MESSAGE ("");
X
X bang := vi$parse_next_ch (i, cmd, "!");
X vi$skip_white (cmd, i);
X
X IF (vi$parse_next_ch (i, cmd, "!")) THEN
X buf := vi$init_buffer ("$$filt_temp$$", "");
X win := CREATE_WINDOW (1, vi$scr_length-1, ON);
X owin := CURRENT_WINDOW;
X IF (buf = 0) OR (win = 0) THEN
X MESSAGE ("Can't get buffer and window for command!");
X RETURN (1);
X ENDIF;
X
X SET (STATUS_LINE, win, REVERSE,
X "*Output from command: "+vi$rest_of_line (cmd,i));
X MAP (win, buf);
X UPDATE (win);
X vi$pasthru_off;
X proc := CREATE_PROCESS (buf, vi$rest_of_line (cmd, i));
X IF proc <> 0 THEN
X SEND (whole_range, proc);
X IF proc <> 0 THEN
X SEND_EOF (proc);
X ENDIF;
X ENDIF;
X UPDATE (win);
X MESSAGE ("[Hit RETURN to continue]");
X LOOP
X EXITIF vi$read_a_key = RET_KEY;
X ENDLOOP;
X
X vi$pasthru_on;
X UNMAP (win);
X DELETE (win);
X DELETE (buf);
X POSITION (owin);
X RETURN (1);
X ENDIF;
X
X range_used := 0;
X IF (no_spec) AND (vi$select_pos <> 0) THEN
X whole_range := SELECT_RANGE;
X no_spec := 0;
X range_used := 1;
X ENDIF;
X
X vi$skip_white (cmd, i);
X ncmd := vi$rest_of_line (cmd, i);
X vi$process_special (ncmd, token_2);
X
X IF (token_2 <> "") THEN
X res_spec := FILE_PARSE (token_2);
X
X outf := FILE_SEARCH ("");
X outf := FILE_SEARCH (res_spec);
X IF (outf <> "") AND
X (outf <> GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE")) AND
X NOT bang THEN
X vi$message (token_2 +
X ' exists - use "' +
X token_1 +
X '! ' +
X token_2 +
X '" to overwrite.');
X RETURN (1);
X ELSE
X vi$message ("Writing out """+res_spec+"""");
X IF (no_spec = 0) THEN
X WRITE_FILE (whole_range, res_spec);
X ELSE
X WRITE_FILE (CURRENT_BUFFER, res_spec);
X ENDIF;
X ENDIF;
X ELSE
X IF (no_spec = 0) THEN
X IF bang THEN
X vi$message ('Use "w!" to write partial buffer');
X outf := "";
X ELSE
X outf := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE");
X IF outf <> "" THEN
X vi$message ("Writing out """+outf+"""");
X outf := WRITE_FILE (whole_range, outf);
X ELSE
X vi$message ("Buffer has no output file!");
X ENDIF;
X ENDIF;
X ELSE
X vi$message ("Writing out """+
X GET_INFO (CURRENT_BUFFER, "NAME")+"""");
X outf := WRITE_FILE (CURRENT_BUFFER);
X ENDIF;
X
X IF (outf <> "") THEN
X SET (OUTPUT_FILE, CURRENT_BUFFER, outf);
X ENDIF;
X ENDIF;
X
X IF range_used THEN
X vi$select_pos := 0;
X ENDIF;
X
X vi$kill_undo;
X vi$undo_end := 0;
X
X ! Always leave message visible
X
X RETURN (1);
XENDPROCEDURE;
X
X!
X! Perform the EX mode read command.
X!
XPROCEDURE vi$do_read (cmd, i, start_line, olen)
X LOCAL
X outf,
X spos,
X epos,
X ret,
X token_2,
X token_3;
X
X MESSAGE ("");
X
X token_3 := vi$rest_of_line (cmd, i);
X vi$process_special (token_3, token_2);
X i := 1;
X vi$skip_white (token_3, i);
X IF (vi$parse_next_ch (i, token_3, "!")) THEN
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X vi$move_vertical (1);
X SPLIT_LINE;
X MOVE_HORIZONTAL (-1);
X vi$kill_undo;
X epos := MARK (NONE);
X spos := MARK (NONE);
X vi$undo_start := vi$get_undo_start;
X ret := vi$filter_region (CREATE_RANGE (spos, epos, NONE),
X vi$rest_of_line (token_3, i));
X MOVE_HORIZONTAL (-1);
X vi$undo_end := MARK (NONE);
X vi$undo_start := vi$set_undo_start (vi$undo_start);
X POSITION (vi$undo_start);
X RETURN (ret);
X ENDIF;
X
X token_3 := vi$rest_of_line (cmd, i);
X vi$process_special (token_3, token_2);
X
X IF (token_2 <> "") THEN
X token_2 := FILE_PARSE (token_2);
X outf := FILE_SEARCH ("");
X outf := FILE_SEARCH (token_2);
X IF (outf <> "") THEN
X IF (start_line > 0) THEN
X POSITION (BEGINNING_OF (CURRENT_BUFFER));
X MOVE_VERTICAL (start_line - 1);
X ENDIF;
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X IF (MARK (NONE) = END_OF (CURRENT_BUFFER)) THEN
X SPLIT_LINE;
X ELSE
X MOVE_VERTICAL (1);
X ENDIF;
X MOVE_HORIZONTAL (-1);
X spos := MARK (NONE);
X MOVE_HORIZONTAL (1);
X outf := READ_FILE (outf);
X IF (outf <> "") THEN
X MOVE_HORIZONTAL (-1);
X vi$undo_end := MARK (NONE);
X vi$kill_undo;
X POSITION (spos);
X MOVE_HORIZONTAL (1);
X vi$undo_start := MARK (NONE);
X ENDIF;
X ELSE
X vi$message (token_2 + " does not exist!");
X ENDIF;
X ELSE
X vi$message ("Filename required!");
X ENDIF;
X vi$check_length (olen);
X
X ! Always leave last message visible
X
X RETURN (1);
XENDPROCEDURE;
X
X!
X! Perform the EX mode file command.
X!
XPROCEDURE vi$do_file_ex (cmd, i)
X LOCAL
X token_2;
X
X ON_ERROR
X IF ERROR = TPU$_PARSEFAIL THEN
X vi$message ("Don't understand filename: "+token_2);
X ENDIF;
X ENDON_ERROR;
X
X MESSAGE ("");
X token_2 := vi$rest_of_line (cmd, i);
X IF (token_2 <> "") THEN
X token_2 := FILE_PARSE (token_2);
X SET (OUTPUT_FILE, CURRENT_BUFFER, token_2);
X vi$status_lines (CURRENT_BUFFER);
X ENDIF;
X vi$what_line;
X
X RETURN (1);
XENDPROCEDURE;
X
X!
X! Perform the EX mode buffer command.
X!
XPROCEDURE vi$do_buffer (cmd, i, token_1)
X
X LOCAL
X buf,
X bang,
X separ,
X token_2,
X token_3;
X
X ON_ERROR
X IF ERROR = TPU$_PARSEFAIL THEN
X MESSAGE ("Don't understand filename given!");
X RETURN (1);
X ENDIF;
X ENDON_ERROR;
X
X MESSAGE ("");
X bang := vi$parse_next_ch (i, cmd, "!");
X
X token_2 := vi$skip_separ (cmd, i, " ", separ);
X token_3 := vi$skip_separ (cmd, i, " ", separ);
X
X IF (vi$rest_of_line (cmd, i) <> "") THEN
X vi$message ("Too many paramters!");
X RETURN (1);
X ENDIF;
X
X IF (token_2 <> "") THEN
X IF (token_3 = "") THEN
X buf := vi$find_buffer_by_name (token_2);
X IF buf = 0 THEN
X buf := vi$_create_buffer (token_2, 0, 0);
X ENDIF;
X ELSE
X token_3 := FILE_PARSE (token_3);
X buf := vi$_create_buffer (token_2, token_3, token_3);
X ENDIF;
X
X IF (buf <> 0) THEN
X vi$check_auto_write;
X MAP (CURRENT_WINDOW, buf);
X vi$set_status_line (CURRENT_WINDOW);
X ENDIF;
X ELSE
X vi$what_line;
X ENDIF;
X
X vi$kill_undo;
X vi$undo_end := 0;
X RETURN (1);
XENDPROCEDURE;
X
X!
X! Perform the EX mode "vi" and/or "edit" commands.
X!
XPROCEDURE vi$do_edit (cmd, i, token_1)
X LOCAL
X buf,
X bang,
X num,
X look,
X ch,
X endch,
X token_2;
X
X num := -1;
X look := -1;
X
X MESSAGE ("");
X bang := vi$parse_next_ch (i, cmd, "!");
X vi$skip_white (cmd, i);
X IF vi$parse_next_ch (i, cmd, "+") THEN
X ! Get a goto spec.
X IF vi$parse_next_ch (i, cmd, "/") THEN
X ! Get a search string
X look := "";
X IF vi$parse_next_ch (i, cmd, '"') THEN
X endch := '"';
X ELSE
X endch := " ";
X ENDIF;
X LOOP
X ch := vi$next_char (cmd, i);
X EXITIF (endch = ch) OR (ch = "");
X IF (ch = "/") THEN
X ch := vi$next_char (cmd, i);
X IF ch <> '"' THEN
X ch := "/" + ch;
X ENDIF;
X ENDIF;
X look := look + ch;
X ENDLOOP;
X vi$skip_white (cmd, i);
X ELSE
X ! Get a number
X num := "";
X LOOP
X EXITIF INDEX (vi$_numeric_chars, SUBSTR (cmd, i, 1)) = 0;
X num := num + vi$next_char (cmd, i);
X ENDLOOP;
X vi$skip_white (cmd, i);
X num := INT (num);
X ENDIF;
X ENDIF;
X token_2 := vi$rest_of_line (cmd, i);
X
X ! Check for use of % as file name, this means current file, so it is
X ! synonomous with specifying no filename.
X
X IF (token_2 = "") OR (token_2 = "%") THEN
X IF (NOT bang) AND (GET_INFO (CURRENT_BUFFER, "MODIFIED")) THEN
X vi$message ("No write since last change, use """ +
X token_1 + "!"" to override");
X RETURN (1);
X ENDIF;
X
X token_2 := GET_INFO (CURRENT_BUFFER, "FILE_NAME");
X IF (token_2 = 0) OR (token_2 = "") THEN
X vi$message ("Buffer has no file!");
X RETURN (1);
X ENDIF;
X
X ! Get everything but the version.
X
X token_2 := FILE_PARSE (token_2, "", "", DEVICE) +
X FILE_PARSE (token_2, "", "", DIRECTORY) +
X FILE_PARSE (token_2, "", "", NAME) +
X FILE_PARSE (token_2, "", "", TYPE);
X
X buf := CURRENT_BUFFER;
X MAP (CURRENT_WINDOW, MESSAGE_BUFFER);
X POSITION (MESSAGE_BUFFER);
X DELETE (buf);
X ENDIF;
X
X ! Check for abbreviation for previous file, and just swap buffers if
X ! that is the case.
X
X IF (token_2 = "#") THEN
X vi$move_prev_buf;
X ELSE
X vi$get_file (token_2);
X vi$pos_in_middle (MARK (NONE));
X vi$kill_undo;
X vi$undo_end := 0;
X ENDIF;
X IF (num <> -1) THEN
X vi$move_to_line (num);
X vi$pos_in_middle (MARK (NONE));
X ELSE
X IF (look <> -1) THEN
X vi$search_string := look;
X num := vi$find_str (look, 0);
X IF (num <> 0) THEN
X vi$position (num, 1);
X vi$pos_in_middle (MARK (NONE));
X ENDIF;
X ENDIF;
X ENDIF;
X RETURN (1);
XENDPROCEDURE;
X
X!
X! Perform the EX mode messages command.
X!
XPROCEDURE vi$do_messages
X MAP (CURRENT_WINDOW, MESSAGE_BUFFER);
X POSITION (MESSAGE_BUFFER);
X vi$set_status_line (CURRENT_WINDOW);
X vi$kill_undo;
X vi$undo_end := 0;
X RETURN (0);
XENDPROCEDURE;
X
X!
X! Perform the EX mode tag command.
X!
XPROCEDURE vi$do_tag (tag_str);
X vi$load_tags;
X RETURN (vi$to_tag (tag_str));
XENDPROCEDURE;
X
X!
X! Load the tags files into a buffer
X!
XPROCEDURE vi$load_tags
X LOCAL
X idx,
X fname,
X ch,
X flist,
X pos;
X
X ON_ERROR
X ENDON_ERROR;
X
X pos := MARK (NONE);
X ERASE (vi$tag_buf);
X
X POSITION (BEGINNING_OF (vi$tag_buf));
X idx := 0;
X fname := "";
X
X flist := vi$tag_files + " ";
X LOOP
X EXITIF (idx > LENGTH(flist));
X ch := SUBSTR (flist, idx, 1);
X IF (INDEX (" ", ch) <> 0) AND (fname <> "") THEN
X vi$info_success_off;
X fname := FILE_PARSE (fname);
X IF (fname <> "") AND (FILE_SEARCH (fname) <> "") THEN
X READ_FILE (FILE_PARSE (fname));
X ENDIF;
X vi$info_success_on;
X fname := "";
X ELSE
X IF (INDEX (" ", ch) = 0) THEN
X fname := fname + ch;
X ENDIF;
X ENDIF;
X idx := idx + 1;
X ENDLOOP;
X
X POSITION (pos);
X RETURN (0);
XENDPROCEDURE;
X
X!
X! Position to the tag given or use the current symbol in the buffer
X!
XPROCEDURE vi$to_tag (tag)
X LOCAL
X fname,
X sch_pat,
X tloc,
X pos;
X
X ON_ERROR
X ENDON_ERROR;
X
X pos := MARK (NONE);
X
X IF (tag = 0) THEN
X tag := vi$sym_name;
X ENDIF;
X
X IF (tag = "") THEN
X MESSAGE ("Bad tag name");
X POSITION (pos);
X RETURN (1);
X ENDIF;
X
X POSITION (BEGINNING_OF (vi$tag_buf));
X IF (MARK (NONE) = END_OF (vi$tag_buf)) THEN
X MESSAGE ("NO tags file!");
X POSITION (pos);
X RETURN (1);
X ENDIF;
X vi$global_var := 0;
X EXECUTE (COMPILE ("vi$global_var := LINE_BEGIN & '"+tag+" '"));
X vi$info_success_off;
X tloc := SEARCH (vi$global_var, FORWARD, vi$tag_case);
X vi$info_success_on;
X IF (tloc <> 0) THEN
X POSITION (END_OF (tloc));
X MOVE_HORIZONTAL (1);
X fname := vi$space_word;
X sch_pat := SUBSTR (CURRENT_LINE, CURRENT_OFFSET+2, 1024);
X POSITION (pos);
X IF (vi$get_file (fname) > 0) THEN
X POSITION (END_OF (CURRENT_BUFFER));
X IF (vi$do_cmd_line (sch_pat)) THEN
X POSITION (BEGINNING_OF (CURRENT_BUFFER));
X MESSAGE ("Tag not found!");
X RETURN (1);
X ENDIF;
X vi$pos_in_middle (MARK (NONE));
X ENDIF;
X ELSE
X POSITION (pos);
X MESSAGE ("Tag not in tags file");
X RETURN (1);
X ENDIF;
X RETURN (0);
XENDPROCEDURE;
X
X!
X! Return the word that is spanned by characters in the symbol set.
X!
XPROCEDURE vi$sym_name
X LOCAL
X ch;
X
X ch := "";
X LOOP
X EXITIF INDEX (vi$_sym_chars, CURRENT_CHARACTER) = 0;
X ch := ch + CURRENT_CHARACTER;
X MOVE_HORIZONTAL (1);
X ENDLOOP;
X RETURN (ch);
XENDPROCEDURE;
X
X!
X! Return the word that is spanned by non-blank characters.
X!
XPROCEDURE vi$space_word
X LOCAL
X ch;
X
X ch := "";
X LOOP
X EXITIF (CURRENT_CHARACTER = " ") OR (CURRENT_CHARACTER = " ");
X ch := ch + CURRENT_CHARACTER;
X MOVE_HORIZONTAL (1);
X ENDLOOP;
X RETURN (ch);
XENDPROCEDURE;
X
X!
X! Perform the EX mode tpu command.
X!
XPROCEDURE vi$do_tpu (cmd, i, no_spec, whole_range)
X
X ON_ERROR
X RETURN (1);
X ENDON_ERROR;
X
X IF no_spec AND (vi$rest_of_line (cmd, i) <> "") THEN
X EXECUTE (COMPILE (vi$rest_of_line (cmd, i)));
X ELSE
X vi$message ("Compiling...");
X IF no_spec AND (vi$rest_of_line (cmd, i) = "") THEN
X IF (vi$select_pos <> 0) THEN
X EXECUTE (COMPILE (SELECT_RANGE));
X vi$select_pos := 0;
X ELSE
X vi$message ("Nothing selected to compile!");
X RETURN (1);
X ENDIF;
X ELSE
X COMPILE (whole_range);
X ENDIF;
X ENDIF;
X
X RETURN (1);
XENDPROCEDURE;
X
X!
X!
X!
XPROCEDURE vi$do_wq (cmd, i, no_spec, token_1, whole_range)
X vi$do_write (cmd, i, no_spec, token_1, whole_range);
X vi$do_quit (cmd, token_1);
X RETURN (1);
XENDPROCEDURE;
X!
X! Perform the EX mode quit command.
X!
XPROCEDURE vi$do_quit (cmd, token_1)
X LOCAL
X buf;
X
X buf := GET_INFO (BUFFERS, "FIRST");
X LOOP
X EXITIF buf = 0;
X IF GET_INFO (buf, "MODIFIED") AND
X (NOT GET_INFO (buf, "SYSTEM")) THEN
X IF NOT GET_INFO (buf, "NO_WRITE") THEN
X IF INDEX (cmd, "!") <> 0 THEN
X SET (NO_WRITE, buf);
X ELSE
V vi$message ("No write of buffer """+GET_INFO (buf, "NAME")
X +
X """ since last change, use """+token_1 +
X "!"" to override.");
X RETURN (1);
X ENDIF;
X ENDIF;
X ENDIF;
X buf := GET_INFO (BUFFERS, "NEXT");
X ENDLOOP;
X vi$quit;
X RETURN (1);
XENDPROCEDURE;
X
X!
X! Delete the buffer given by the name passed as the parameter. The buffer
X! must not be the current buffer, or if it is, there must be more than
X! one buffer on the screen.
X!
XPROCEDURE vi$do_delbuf (cmd, i)
X
X LOCAL
X win,
X confirm,
X possible_buffer,
X possible_buffer_name,
X found_a_buffer,
X how_many_buffers,
X this_buffer,
X loop_buffer,
X bang,
X buffer_name;
X
X ! Get the buffer name, solving abiguity problems.
X
X bang := vi$parse_next_ch (i, cmd, "!");
X vi$skip_white (cmd, i);
X buffer_name := vi$rest_of_line (cmd, i);
X CHANGE_CASE (buffer_name, UPPER); ! for messages
X loop_buffer := vi$find_buffer_by_name (buffer_name);
X
X IF (loop_buffer <> 0) THEN
X buffer_name := GET_INFO (loop_buffer, "NAME");
X
X ! Now, we must first delete all windows mapped to this buffer.
X
X win := GET_INFO (WINDOWS, "FIRST");
X LOOP
X EXITIF (win = 0);
X EXITIF (GET_INFO (loop_buffer, "MAP_COUNT") = 0);
X
X ! See if current window is mapped to this buffer.
X
X IF (GET_INFO (win, "BUFFER") = loop_buffer) THEN
X
X ! If so, there must be a previous or a next window to move to.
X ! If there is not, then we can not delete the buffer until
X ! another buffer (and window) are available to move to.
X
X IF (vi$prev_win (win) <> 0) OR (vi$next_win(win) <> 0) THEN
X POSITION (win);
X vi$del_win (win);
X
X ! Restart at beginning of list. Deleting a window will
X ! make "NEXT" not work.
X
X win := GET_INFO (WINDOWS, "FIRST");
X ELSE
X MESSAGE ("Can't unmap all windows that are mapped to """ +
X buffer_name + """!");
X RETURN (1);
X ENDIF;
X ELSE
X win := GET_INFO (WINDOWS, "NEXT");
X ENDIF;
X ENDLOOP;
X ELSE
X MESSAGE ("No such buffer, "+buffer_name);
X RETURN (1);
X ENDIF;
X
X CHANGE_CASE (buffer_name, UPPER);
X IF (GET_INFO (loop_buffer, "MAP_COUNT") = 0) THEN
X IF (GET_INFO (loop_buffer, "MODIFIED") AND NOT bang) THEN
X confirm := READ_LINE ("Delete modified buffer, """+
X buffer_name+"""? ");
X
X EDIT (confirm, UPPER);
X IF (SUBSTR (confirm, 1, 1) <> "Y") THEN
X MESSAGE ("Buffer NOT deleted!");
X RETURN (1);
X ENDIF;
X ENDIF;
X
X DELETE (loop_buffer);
X MESSAGE ("Buffer, """+buffer_name+""", deleted!");
X ELSE
X MESSAGE ("Can't delete """+buffer_name+
V """, it is still mapped to a window!")
X;
X RETURN (1);
X ENDIF;
X
X! Normally we would return 0, but the above message must remain visible.
X
X RETURN (1);
XENDPROCEDURE;
X!
X! Return the proper value of a MARKER that indicates the previous position
X! in the current buffer.
X!
XPROCEDURE vi$get_undo_start
X LOCAL
X pos;
X
X IF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) THEN
X RETURN (0);
X ELSE
X MOVE_HORIZONTAL (-1);
X pos := MARK (NONE);
X MOVE_HORIZONTAL (1);
X RETURN (pos);
X ENDIF;
XENDPROCEDURE;
X
X!
X! Use "spos" to determine where "vi$undo_start" should be set.
X!
XPROCEDURE vi$set_undo_start (spos)
X IF spos = 0 THEN
X RETURN (BEGINNING_OF (CURRENT_BUFFER));
X ELSE
X POSITION (spos);
X MOVE_HORIZONTAL (1);
X RETURN (MARK (NONE));
X ENDIF;
XENDPROCEDURE;
X
X!
X! If this was real VI under UNIX, all you would need to do is filter text
X! through NROFF... sigh... I guess you can't have it all?
X!
XPROCEDURE vi$fill_region (leftm, rightm, rng)
X LOCAL
X pos,
X end,
X spos,
X beg;
X
X IF (leftm = 0) THEN
X leftm := 1;
X ENDIF;
X
X IF (rightm = 0) THEN
X rightm := vi$scr_width;
X ENDIF;
X
X POSITION (BEGINNING_OF (rng));
X LOOP
X EXITIF (CURRENT_CHARACTER <> " ") AND (CURRENT_CHARACTER <> " ");
X MOVE_HORIZONTAL (1);
X EXITIF (MARK (NONE) = END_OF (rng));
X ENDLOOP;
X
X beg := MARK (NONE);
X POSITION (END_OF (rng));
X MOVE_HORIZONTAL (-1);
X end := MARK (NONE);
X rng := CREATE_RANGE (beg, end, NONE);
X POSITION (BEGINNING_OF (rng));
X vi$save_for_undo (rng, VI$IN_LINE_MODE, 1);
X spos := vi$get_undo_start;
X
X FILL (rng, " ", leftm, rightm);
X vi$undo_end := MARK (NONE);
X vi$undo_start := vi$set_undo_start (spos);
X POSITION (vi$undo_start);
XENDPROCEDURE;
X
X!
X! Given a buffer name, return the buffer TYPE variable for that buffer.
X!
XPROCEDURE vi$find_buffer_by_name (bname_param)
X LOCAL
X cnt,
X bname,
X possible,
X pbuf,
X buf;
X
X bname := bname_param;
X CHANGE_CASE (bname, UPPER);
X buf := GET_INFO (BUFFERS, "FIRST");
X cnt := 0;
X
X LOOP
X EXITIF buf = 0;
X possible := GET_INFO (buf, "NAME");
X EXITIF bname = possible;
X IF vi$leading_str (bname, possible) THEN
X cnt := cnt + 1;
X pbuf := buf;
X ENDIF;
X buf := GET_INFO (BUFFERS, "NEXT");
X ENDLOOP;
X
X IF buf = 0 THEN
X IF cnt = 1 THEN
X buf := pbuf;
X ENDIF;
X ENDIF;
X
X RETURN (buf);
XENDPROCEDURE;
X
X!
X! Effect a key mapping, and squirl away the original mapping so that
X! it can be restore later.
X!
XPROCEDURE vi$map_keys (cmd, i)
X LOCAL
X comment_string,
X separ,
X pos,
X buf,
X map_type,
X keyn,
X key;
X
X map_type := vi$cmd_keys;
X IF (vi$parse_next_ch (i, cmd, "!")) THEN
X map_type := vi$edit_keys;
X ENDIF;
X
X IF SUBSTR (cmd, i, 1) <> " " THEN
X vi$show_maps;
X RETURN(1);
X ENDIF;
X
X vi$skip_white (cmd, i);
X
X IF (i > LENGTH (cmd)) THEN
X vi$show_maps;
X RETURN (1);
X ENDIF;
X
X key := KEY_NAME (SUBSTR (cmd, i, 1));
X i := i + 1;
X comment_string := LOOKUP_KEY (key, COMMENT, map_type);
X
X vi$skip_white (cmd, i);
X
X IF (key < 32) THEN
X key := ((CTRL_B_KEY - CTRL_A_KEY) * (key - 1)) + CTRL_A_KEY;
X ENDIF;
X
X keyn := vi$key_map_name (key);
X
X IF (map_type = vi$edit_keys) AND (comment_string <> 0) AND
X (comment_string <> "") AND (comment_string <> "active_macro") THEN
X vi$message ("You can't redefine that key!");
X RETURN (1);
X ENDIF;
X
X vi$global_var := 0;
X IF comment_string <> "active_macro" THEN
X EXECUTE (COMPILE (
X "vi$global_var := vi$init_buffer ('vi$$key_map_" +
X keyn + map_type + "', '');"));
X
X buf := vi$global_var;
X EXECUTE (COMPILE ("vi$$key_map_buf_" +
X keyn + map_type + " := vi$global_var;"));
X pos := MARK (NONE);
X POSITION (buf);
X SPLIT_LINE;
X COPY_TEXT (comment_string);
X ELSE
X EXECUTE (COMPILE ("vi$global_var := vi$$key_map_buf_" +
X keyn + map_type + ";"));
X buf := vi$global_var;
X pos := MARK (NONE);
X POSITION (BEGINNING_OF (buf));
X LOOP
X EXITIF (CURRENT_LINE = "");
X ERASE_LINE;
X ENDLOOP;
X ENDIF;
X
X POSITION (BEGINNING_OF (buf));
X
X LOOP
X EXITIF (i > LENGTH (cmd));
X COPY_TEXT (STR (KEY_NAME (SUBSTR (cmd, i, 1))));
X SPLIT_LINE;
X i := i + 1;
X ENDLOOP;
X
X POSITION (BEGINNING_OF (buf));
X POSITION (pos);
X
X vi$info_success_off;
X
X IF (map_type = vi$edit_keys) THEN
X EXECUTE (COMPILE
X ("DEFINE_KEY ('vi$insert_macro_keys (vi$$key_map_buf_" + keyn +
V map_type + ")', " + STR(key) + ", 'active_macro', vi$edit_keys);")
X);
X ELSE
V EXECUTE (COMPILE ("DEFINE_KEY ('vi$do_macro (vi$$key_map_buf_" + keyn
X+
X map_type + ", 1)', " + STR(key) +
X ", 'active_macro', vi$cmd_keys);"));
X ENDIF;
X
X vi$info_success_on;
X RETURN (0);
XENDPROCEDURE;
X
X!
X! Unmap a key mapping and restore the original if one existed.
X!
XPROCEDURE vi$unmap_keys (cmd, i)
X LOCAL
X comment_string,
X separ,
X pos,
X buf,
X map_type,
X keyn,
X key;
X
X map_type := vi$cmd_keys;
X IF (SUBSTR (cmd, i, 1) = "!") THEN
X map_type := vi$edit_keys;
X i := i + 1;
X ELSE
X IF SUBSTR (cmd, i, 1) <> " " THEN
X vi$message ("Bad command!");
X RETURN;
X ENDIF;
X ENDIF;
X
X vi$skip_white (cmd, i);
X
X key := KEY_NAME (SUBSTR (cmd, i ,1));
X
X comment_string := LOOKUP_KEY (key, COMMENT, map_type);
X
X IF comment_string <> "active_macro" THEN
X vi$message ("Key not currently mapped!");
X RETURN;
X ENDIF;
X
X keyn := vi$key_map_name (key);
X
X vi$global_var := 0;
X EXECUTE (COMPILE ("vi$global_var := vi$$key_map_buf_" +
X keyn + map_type + ";"));
X buf := vi$global_var;
X
X pos := MARK (NONE);
X POSITION (END_OF (buf));
X MOVE_VERTICAL (-1);
X
X vi$info_success_off;
X EXECUTE (COMPILE ("DEFINE_KEY ('"+CURRENT_LINE +
X "', "+STR(key)+", '"+CURRENT_LINE+"', '" + map_type + "')"));
X vi$info_success_on;
X
$ GoSub Convert_File
$ Exit