home *** CD-ROM | disk | FTP | other *** search
- Path: xanth!mcnc!gatech!bloom-beacon!bu-cs!mirror!necntc!ncoast!allbery
- From: gregg@a.cs.okstate.edu (Gregg Wonderly)
- Newsgroups: comp.sources.misc
- Subject: v04i102: TPUVI for VMS part 11 of 17
- Message-ID: <8809212110.AA10844@uunet.UU.NET>
- Date: 27 Sep 88 01:56:36 GMT
- Sender: allbery@ncoast.UUCP
- Reply-To: gregg@a.cs.okstate.edu (Gregg Wonderly)
- Lines: 1504
- Approved: allbery@ncoast.UUCP
-
- Posting-number: Volume 4, Issue 102
- Submitted-by: "Gregg Wonderly" <gregg@a.cs.okstate.edu>
- Archive-name: vms-vi-2/Part11
-
- $ WRITE SYS$OUTPUT "Creating ""VI.7"""
- $ CREATE VI.7
- $ DECK/DOLLARS=$$EOD$$
- vi$info ("Press key to bind sequence to: ");
- keyn := vi$read_a_key;
-
- IF (keyn = F11) OR (ASCII (27) = ASCII (keyn)) THEN
- vi$info ("LEARN aborted!");
- com := LEARN_END;
- vi$in_learn := 0;
- RETURN (1);
- ENDIF;
-
- com := LOOKUP_KEY (keyn, COMMENT, vi$cmd_keys);
- IF (com = "active_macro") THEN
- vi$info ("That key is a mapped key, you must unmap it first");
- RETURN (1);
- ENDIF;
-
- key := "vi$ls_"+vi$key_map_name (keyn);
- EXECUTE (COMPILE (key+":=LEARN_END"));
- vi$in_learn := 0;
- DEFINE_KEY ("vi$play_back("+key+")", keyn, "learn_sequence", vi$cmd_keys);
- vi$info ("Sequence bound to key");
- RETURN (1);
- ENDPROCEDURE;
-
- !
- !
- !
- PROCEDURE vi$play_back (prog)
- LOCAL
- old_play_back,
- old_global;
-
- IF (vi$m_level > 30) THEN
- vi$info ("Infinite loop detected in key macro sequence!");
- RETURN;
- ENDIF;
- vi$m_level := vi$m_level + 1;
-
- IF vi$undo_map THEN
- old_global := vi$in_global;
- vi$in_global := 0;
- IF (NOT old_global) THEN
- vi$save_for_undo (CURRENT_BUFFER, VI$LINE_MODE, 1);
- vi$in_global := 1;
- ENDIF;
- ENDIF;
-
- old_play_back := vi$playing_back;
- vi$playing_back := 1;
- EXECUTE (prog);
- vi$playing_back := old_play_back;
- vi$m_level := vi$m_level - 1;
-
- vi$in_global := old_global;
- ENDPROCEDURE;
-
- !
- ! Remove an abbreviation
- !
- PROCEDURE vi$do_unabbr (cmd, i)
- LOCAL
- separ,
- junk,
- idx,
- ch,
- abbr,
- abbrn;
-
- abbr := "";
- abbrn := "";
-
- junk := vi$skip_separ (cmd, i, vi$_space_tab, separ);
- IF (LENGTH (junk) = 0) THEN
- vi$info ("Abbreviation name required!");
- RETURN (1);
- ENDIF;
-
- idx := 1;
- LOOP
- EXITIF idx > LENGTH (junk);
- ch := SUBSTR (junk, idx, 1);
- IF (INDEX (vi$_alpha_chars, ch) = 0) THEN
- vi$info ("Invalid character in UNABBR name, '"+ch+
- "', is not valid.");
- RETURN (1);
- ENDIF;
- IF (INDEX (vi$_upper_chars, ch) <> 0) THEN
- abbrn := abbrn + "_";
- ENDIF;
- abbrn := abbrn + ch;
- idx := idx + 1;
- ENDLOOP;
- EXECUTE (COMPILE ("VI$ABBR_"+abbrn+":=0;"));
- RETURN (0);
- ENDPROCEDURE;
-
- !
- ! Create an abbreviation
- !
- PROCEDURE vi$do_abbr (cmd, i)
- LOCAL
- separ,
- abbr,
- nabbr,
- junk,
- idx,
- ch,
- abbrn;
-
- abbr := "";
- abbrn := "";
-
- ! Check for query.
-
- junk := vi$skip_separ (cmd, i, vi$_space_tab, separ);
- IF (LENGTH (junk) = 0) THEN
- vi$show_abbrevs;
- RETURN (0);
- ENDIF;
-
- ! Check that the abbrievation name can be part of a variable name
-
- idx := 1;
- LOOP
- EXITIF idx > LENGTH (junk);
- ch := SUBSTR (junk, idx, 1);
- IF (INDEX (vi$_alpha_chars, ch) = 0) THEN
- vi$info ("Invalid character in ABBR name, '"+ch+"', is not valid.");
- RETURN (1);
- ENDIF;
- IF (INDEX (vi$_upper_chars+"_", ch) <> 0) THEN
- abbrn := abbrn + "_";
- ENDIF;
- abbrn := abbrn + ch;
- idx := idx + 1;
- ENDLOOP;
-
- abbr := vi$rest_of_line (cmd, i);
-
- nabbr := vi$dbl_chars ('"', abbr);
- EXECUTE (COMPILE ("VI$ABBR_"+abbrn+":="""+nabbr+""""));
- RETURN (0);
- ENDPROCEDURE;
-
- PROCEDURE vi$dbl_chars (dch, line)
-
- LOCAL
- ch,
- idx,
- nstr;
-
- ! Double all '"' quotes.
-
- idx := 1;
- nstr := "";
- LOOP
-
- EXITIF idx > LENGTH (line);
- ch := SUBSTR (line, idx, 1);
- IF (ch = dch) THEN
- ch := dch+dch;
- ENDIF;
- nstr := nstr + ch;
- idx := idx + 1;
- ENDLOOP;
-
- RETURN (nstr);
- ENDPROCEDURE;
- !
- ! Execute the contents of the buffers named following an '@'.
- !
- PROCEDURE vi$do_macro_buffer (cmd, i)
- LOCAL
- line,
- mode,
- buf_name,
- pos,
- buf,
- ch;
-
- ON_ERROR
- ENDON_ERROR;
-
- vi$skip_white (cmd, i);
-
- LOOP
- ch := vi$next_char (cmd, i);
- EXITIF (ch = "");
-
- IF (INDEX ("123456789", ch) <> 0) THEN
-
- ! Selected a deletion buffer.
-
- buf_name := "vi$del_buf_" + ch;
- ELSE
- IF (INDEX (vi$_letter_chars, ch) <> 0) THEN
-
- ! Selected a named buffer.
-
- CHANGE_CASE (ch, LOWER);
-
- buf_name := "vi$ins_buf_" + ch;
- ELSE
- vi$info ("Invalid buffer!");
- RETURN;
- ENDIF;
- ENDIF;
-
- vi$global_var := 0;
- EXECUTE (COMPILE ("vi$global_var := "+buf_name+";"));
- buf := vi$global_var;
- IF (buf = 0) THEN
- vi$info ("There is no text in that buffer!");
- RETURN;
- ENDIF;
-
- pos := MARK (NONE);
- POSITION (BEGINNING_OF (buf));
-
- ! Skip the buffer mode indicator.
-
- mode := INT (vi$current_line);
- MOVE_VERTICAL (1);
- line := vi$current_line;
-
- IF mode = VI$LINE_MODE THEN
- line := line + ASCII (13);
- ENDIF;
-
- POSITION (pos);
- vi$do_macro (line, 1);
- ENDLOOP;
-
- ENDPROCEDURE;
-
- !
- ! Do the ex mode 'g' and 'v' commands
- !
- PROCEDURE vi$do_global (cmd, i, cmd_ch)
- LOCAL
- pwin,
- pbuf,
- obuf,
- cmd_str,
- sch_str,
- subs_str,
- sch,
- separ,
- ch,
- nsubs,
- lpos,
- opos,
- olen,
- fpos;
-
- opos := MARK (NONE);
- olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
- vi$skip_white (cmd, i);
- IF NOT vi$parse_next_ch (i, cmd, "/") THEN
- vi$info ("/ Search string must follow global!");
- RETURN (1);
- ENDIF;
-
- sch := SUBSTR (cmd, i-1, 1);
- sch_str := "";
- LOOP
- EXITIF (vi$parse_next_ch (i, cmd, sch));
- EXITIF (LENGTH (cmd) < i);
- ch := SUBSTR (cmd, i, 1);
- IF (ch = "\") THEN
- sch_str := sch_str + SUBSTR (cmd, i, 2);
- i := i + 1;
- ELSE
- sch_str := sch_str + ch;
- ENDIF;
- i := i + 1;
- ENDLOOP;
-
- IF (LENGTH (cmd) < i) THEN
- vi$info ("Incomplete command! ("+cmd+")");
- RETURN (1);
- ENDIF;
-
- vi$save_for_undo (CURRENT_BUFFER, VI$LINE_MODE, 1);
- cmd_str := vi$rest_of_line (cmd, i);
-
- SET (FORWARD, CURRENT_BUFFER);
- POSITION (BEGINNING_OF (CURRENT_BUFFER));
-
- subs := SUBSTR (cmd_str, 1, 1) = "s";
- dell := cmd_str = "d";
- prt := cmd_str = "p";
-
- IF subs THEN
- nsubs := 0;
- subs_str := SUBSTR (cmd_str, 2, 255);
- separ := SUBSTR (subs_str, 2, 1);
- IF (SUBSTR (cmd_str,1,1)+SUBSTR (subs_str, 1, 2) = "s"+separ+separ) THEN
- subs_str := separ+sch_str+separ+SUBSTR (subs_str, 3, 255);
- ENDIF;
- ENDIF;
-
- IF prt THEN
- pwin := CURRENT_WINDOW;
- obuf := CURRENT_BUFFER;
- pbuf := vi$init_buffer ("$$prt_temp$$", "");
- MAP (pwin, pbuf);
- UPDATE (pwin);
- POSITION (BEGINNING_OF (obuf));
- ENDIF;
-
- LOOP
- fpos := vi$find_str (sch_str, 1, 0);
- EXITIF (fpos = 0) AND (cmd_ch = "g");
- EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
-
- IF cmd_ch = "g" THEN
- POSITION (fpos);
- IF dell THEN
- ERASE_LINE;
- ELSE
- IF subs THEN
- lpos := vi$global_subs (subs_str, nsubs);
- POSITION (LINE_BEGIN);
- MOVE_VERTICAL (1);
- ELSE
- IF prt THEN
- vi$prt_line (fpos, CURRENT_LINE, pbuf, pwin);
- MOVE_VERTICAL (1);
- ELSE
- vi$info ("Bad command for global! ("+cmd_str+")");
- vi$kill_undo;
- vi$undo_end := 0;
- RETURN (1);
- ENDIF;
- ENDIF;
- ENDIF;
- ELSE
- IF cmd_ch = "v" THEN
- IF (fpos = 0) THEN
- fpos := END_OF (CURRENT_BUFFER);
- ENDIF;
- POSITION (fpos);
- POSITION (LINE_BEGIN);
- fpos := MARK (NONE);
- POSITION (opos);
- LOOP
- EXITIF (fpos = MARK(NONE));
- EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
- IF dell THEN
- ERASE_LINE;
- ELSE
- IF subs THEN
- lpos := vi$global_subs (subs_str, nsubs);
- POSITION (LINE_BEGIN);
- MOVE_VERTICAL (1);
- ELSE
- IF prt THEN
- POSITION (fpos);
- vi$prt_line (fpos, CURRENT_LINE, pbuf, pwin);
- MOVE_VERTICAL (1);
- ELSE
- vi$info
- ("Bad command for global! ("+cmd_str+")");
- vi$kill_undo;
- vi$undo_end := 0;
- RETURN (1);
- ENDIF;
- ENDIF;
- ENDIF;
- ENDLOOP;
- IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
- MOVE_VERTICAL (1);
- ENDIF;
- opos := MARK (NONE);
- ENDIF;
- ENDIF;
- ENDLOOP;
-
- IF prt THEN
- MESSAGE ("[Hit ENTER to continue]");
- LOOP
- EXITIF (vi$read_a_key = RET_KEY);
- ENDLOOP;
- MESSAGE (" ");
- MAP (pwin, obuf);
- DELETE (pbuf);
- POSITION (opos);
- ENDIF;
-
- IF subs THEN
- vi$info (STR (nsubs) + " substitutions.");
- ENDIF;
-
- IF (subs OR dell) THEN
- POSITION (lpos);
- vi$undo_end := END_OF (CURRENT_BUFFER);
- vi$undo_start := BEGINNING_OF (CURRENT_BUFFER);
- vi$check_length (olen);
- ENDIF;
-
- RETURN (1);
- ENDPROCEDURE;
-
- !
- ! Do print line for g and v EX-mode commands.
- !
- PROCEDURE vi$prt_line (opos, pline, pbuf, pwin)
- POSITION (pbuf);
- COPY_TEXT (pline);
- SPLIT_LINE;
- UPDATE (pwin);
- POSITION (opos);
- ENDPROCEDURE;
-
- !
- ! Print the range of lines indicated, in the current window.
- !
- PROCEDURE vi$do_print (where, startl, endl)
-
- ON_ERROR
- RETURN;
- ENDON_ERROR;
-
- POSITION (where);
-
- SET (FORWARD, CURRENT_BUFFER);
- POSITION (LINE_BEGIN);
- SCROLL (CURRENT_WINDOW, endl-startl);
- vi$info ("[Hit ENTER to continue]");
- LOOP
- EXITIF vi$read_a_key = RET_KEY;
- ENDLOOP;
- vi$pos_in_middle (MARK (NONE));
-
- RETURN (0);
- ENDPROCEDURE;
-
- !
- ! Change the current working directory to the string given. A simple
- ! effort is made to translate the string given, but no other effort is
- ! made to decode the actual logicals emmbeded in the string.
- !
- PROCEDURE vi$do_cd (cmd, i)
-
- LOCAL
- old_dir,
- sysdisk,
- retval,
- orig_nam,
- colon,
- directory_name;
-
- ON_ERROR
- ENDON_ERROR;
-
-
- vi$skip_white (cmd, i);
- directory_name := vi$rest_of_line (cmd, i);
-
- orig_nam := directory_name;
- directory_name := CALL_USER (vi$cu_trnlnm_proc, orig_nam);
- IF (directory_name = "") THEN
- directory_name := CALL_USER (vi$cu_trnlnm_job, orig_nam);
- IF (directory_name = "") THEN
- directory_name := CALL_USER (vi$cu_trnlnm_group, orig_nam);
- IF (directory_name = "") THEN
- directory_name := CALL_USER (vi$cu_trnlnm_sys, orig_nam);
- ENDIF;
- ENDIF;
- ENDIF;
-
- IF (directory_name = "") THEN
- directory_name := orig_nam;
- ENDIF;
-
- colon := INDEX (directory_name, ":");
- sysdisk := CALL_USER (vi$cu_trnlnm_proc, "SYS$DISK");
-
- IF (colon <> 0) THEN
- sysdisk := SUBSTR (directory_name, 1, colon);
- directory_name := SUBSTR (directory_name, colon+1, 255);
- EDIT (sysdisk, UPPER,COLLAPSE);
- retval := CALL_USER (vi$cu_set_sysdisk, sysdisk);
- ENDIF;
-
- TRANSLATE (directory_name, " ", "[]");
- EDIT (directory_name, UPPER,COLLAPSE);
- directory_name := '[' + directory_name + ']';
- old_dir := CALL_USER (vi$cu_cwd, directory_name);
- vi$info ("New directory is " + CALL_USER (vi$cu_trnlnm_proc, "SYS$DISK") +
- CALL_USER (vi$cu_cwd, ""));
-
- RETURN (1);
- ENDPROCEDURE;
-
- !
- ! The show command...
- !
- PROCEDURE vi$do_show (cmd, i)
-
- LOCAL
- act;
-
- vi$skip_white (cmd, i);
- act := vi$rest_of_line (cmd, i);
- CHANGE_CASE (act, LOWER);
- IF (vi$leading_str (act, "files")) THEN
- vi$_show_files;
- ELSE
- IF (vi$leading_str (act, "buffers")) THEN
- vi$_show_buffers;
- ELSE
- IF (vi$leading_str (act, "tags")) THEN
- vi$_show_tags;
- ENDIF;
- ENDIF;
- ENDIF;
- RETURN (0);
- ENDPROCEDURE;
-
- !
- ! Show the current list of abbreviations that are known
- !
- PROCEDURE vi$show_abbrevs
- LOCAL
- buf,
- loc,
- varn,
- rvar,
- i,
- idx,
- ch,
- strg,
- vars,
- errno,
- pos;
-
- ON_ERROR
- errno := ERROR;
- IF (errno <> TPU$_MULTIPLENAMES) AND
- (errno <> TPU$_STRNOTFOUND) THEN
- vi$info (CALL_USER (vi$cu_getmsg, STR(errno)));
- POSITION (pos);
- RETURN;
- ENDIF;
- ENDON_ERROR;
-
- pos := MARK (NONE);
- buf := choice_buffer;
-
- ERASE (buf);
- vars := EXPAND_NAME ("VI$ABBR_", VARIABLES);
- IF (vars = "") THEN
- vi$info ("Humm, there are not any abbreviations!");
- RETURN (1);
- ENDIF;
- POSITION (buf);
- COPY_TEXT (vars);
- POSITION (BEGINNING_OF (buf));
- LOOP
- loc := SEARCH (" ", FORWARD, EXACT);
- EXITIF loc = 0;
- POSITION (BEGINNING_OF (loc));
- ERASE_CHARACTER (1);
- SPLIT_LINE;
- ENDLOOP;
-
- POSITION (BEGINNING_OF (buf));
-
- LOOP
- EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
-
- IF (CURRENT_LINE = "VI$ABBR_") THEN
- ERASE_LINE;
- ELSE
- vi$global_var := 0;
- EXECUTE (COMPILE ("vi$global_var := "+CURRENT_LINE));
- varn := SUBSTR (CURRENT_LINE, 9, 500);
- rvar := "";
- idx := 1;
- LOOP
- EXITIF (vi$global_var = 0);
- EXITIF (idx > LENGTH (VARN));
- ch := SUBSTR (VARN, idx, 1);
- IF (ch = "_") THEN
- ch := SUBSTR (VARN, idx+1, 1);
- IF (INDEX (vi$_upper_chars+"_", ch) <> 0) THEN
- rvar := rvar + ch;
- ELSE
- EDIT (ch, LOWER);
- rvar := rvar + ch;
- ENDIF;
- idx := idx + 1;
- ELSE
- EDIT (ch, LOWER);
- rvar := rvar + ch;
- ENDIF;
- idx := idx + 1;
- ENDLOOP;
- ERASE_LINE;
- IF (vi$global_var <> 0) THEN
- strg := FAO ("!20AS = >!AS<", rvar, vi$global_var);
- COPY_TEXT (strg);
- SPLIT_LINE;
- ENDIF;
- ENDIF;
- ENDLOOP;
- POSITION (BEGINNING_OF (buf));
- POSITION (pos);
- vi$show_list (buf,
- " Current Abbreviations" +
- " ",
- info_window);
- RETURN (0);
- ENDPROCEDURE;
-
- !
- ! Show the current buffers and their attributes
- !
- PROCEDURE vi$_show_buffers
- LOCAL
- mod,
- nr,
- sys,
- pos,
- buf,
- bn;
-
- buf := GET_INFO (BUFFERS, "FIRST");
- ERASE (choice_buffer);
- pos := MARK (NONE);
- POSITION (choice_buffer);
- LOOP
- LOOP
- EXITIF (buf = 0);
- EXITIF (GET_INFO (buf, "SYSTEM") = 0);
- buf := GET_INFO (BUFFERS, "NEXT");
- ENDLOOP;
- EXITIF (buf = 0);
-
- mod := "Not ";
- IF GET_INFO (buf, "MODIFIED") THEN
- mod := "";
- ENDIF;
-
- nr := "";
- IF GET_INFO (buf, "NO_WRITE") THEN
- nr := " No Write";
- ENDIF;
-
- COPY_TEXT (FAO ("Name: !20AS Lines: !5UL !ASModified!AS",
- GET_INFO (buf, "NAME"), GET_INFO (buf, "RECORD_COUNT"),
- mod, nr));
-
- SPLIT_LINE;
-
- IF GET_INFO (buf, "OUTPUT_FILE") = 0 THEN
- COPY_TEXT ("[No output file]");
- ELSE
- COPY_TEXT (FAO ("Output file: !AS",GET_INFO (buf, "OUTPUT_FILE")));
- ENDIF;
-
- SPLIT_LINE;
- SPLIT_LINE;
- buf := GET_INFO (BUFFERS, "NEXT");
- ENDLOOP;
-
- POSITION (BEGINNING_OF (choice_buffer));
- POSITION (pos);
- vi$show_list (choice_buffer,
- " Current buffers and associated information" +
- " ",
- info_window);
- RETURN (0);
- ENDPROCEDURE;
-
- !
- ! Perform the EX mode "&" command.
- !
- PROCEDURE vi$do_subs_alias (cmd, i, start_line, end_line, whole_range)
- IF vi$replace_separ = 0 THEN
- vi$info ("No previous substitution!");
- RETURN;
- ENDIF;
-
- ! Rebuild a proper substitute command.
-
- cmd := SUBSTR (cmd, 1, i-2) + "s" +
- vi$replace_separ + vi$replace_source +
- vi$replace_separ + vi$replace_dest +
- vi$replace_separ + SUBSTR (cmd, i, 255);
-
- RETURN (vi$do_substitute (start_line, end_line, whole_range, i, cmd));
- ENDPROCEDURE;
-
- !
- ! Perform the EX mode "!" command.
- !
- PROCEDURE vi$do_subproc (cmd, i)
- LOCAL
- tstr,
- errno,
- ncmd;
-
- cmd := vi$rest_of_line (cmd, i);
- IF cmd = "!" THEN
- cmd := vi$last_cmd;
- ELSE
- vi$last_cmd := cmd;
- ENDIF;
-
- IF cmd = 0 THEN
- vi$info ("No command on command line!");
- RETURN (1);
- ENDIF;
-
- IF cmd = "" THEN
- vi$info ("Use "":sh"" to get an interactive CLI");
- RETURN (1);
- ENDIF;
-
- IF (vi$process_special (cmd, ncmd)) THEN
- vi$mess_select (NONE);
- vi$info (":!"+ncmd);
- UPDATE (message_window);
- ENDIF;
-
- vi$pasthru_off;
- ncmd := vi$dbl_chars ('"', ncmd);
- vi$spawn ('@VI$ROOT:[EXE]DOSPAWN "'+ncmd+'"');
- vi$pasthru_on;
- vi$mess_select (REVERSE);
- RETURN (0);
- ENDPROCEDURE;
-
- !
- ! This procedure looks at the characters in cmd, and translates occurances
- ! of the characters % and # to the names of the current buffers file, and
- ! the previously edited buffers file, respectively.
- !
- PROCEDURE vi$process_special (cmd, ncmd)
-
- LOCAL
- idx,
- redo,
- ch;
-
- ncmd := "";
- idx := 1;
- redo := 0;
-
- LOOP
- EXITIF idx > LENGTH (cmd);
- ch := SUBSTR (cmd, idx, 1);
- IF (ch = "%") THEN
- ch := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE");
- redo := 1;
- ELSE
- IF(ch = "#") THEN
- IF vi$last_mapped <> 0 THEN
- ch := GET_INFO (vi$last_mapped, "OUTPUT_FILE");
- redo := 1;
- ENDIF;
- ENDIF;
- ENDIF;
- ncmd := ncmd + ch;
- idx := idx + 1;
- ENDLOOP;
-
- RETURN (redo);
- ENDPROCEDURE;
- !
- ! Perform the EX mode copy command.
- !
- PROCEDURE vi$do_copy (cmd, i, whole_range, olen, start_line, end_line)
- LOCAL
- spos,
- dest;
-
- vi$skip_white (cmd, i);
- dest := vi$get_line_spec (i, cmd);
-
- IF (dest > GET_INFO (CURRENT_BUFFER, "RECORD_COUNT")) THEN
- dest := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
- ENDIF;
-
- IF ((dest < start_line) OR (dest > end_line)) AND (dest > 0) THEN
- vi$move_to_line (dest + 1);
- spos := vi$get_undo_start;
- COPY_TEXT (whole_range);
- vi$kill_undo;
- MOVE_HORIZONTAL (-1);
- vi$undo_end := MARK (NONE);
- vi$undo_start := vi$set_undo_start (spos);
- ELSE
- vi$info ("Error in copy range!");
- RETURN (1);
- ENDIF;
-
- vi$check_length (olen);
- RETURN (1);
- ENDPROCEDURE;
-
- !
- ! Perform the EX mode move command.
- !
- PROCEDURE vi$do_move (cmd, i, whole_range, start_line, end_line)
- LOCAL
- dest;
-
- vi$skip_white (cmd, i);
- dest := vi$get_line_spec (i, cmd);
-
- IF (dest > GET_INFO (CURRENT_BUFFER, "RECORD_COUNT")) THEN
- dest := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
- ENDIF;
-
- IF ((dest < start_line) OR (dest > end_line)) AND (dest > 0) THEN
- vi$move_to_line (dest+1);
- vi$undo_end := 0;
- vi$kill_undo;
- MOVE_TEXT (whole_range);
- ELSE
- vi$info ("Error in move range!");
- RETURN (1);
- ENDIF;
- RETURN (0);
- ENDPROCEDURE;
-
- !
- ! Perform the EX mode select command.
- !
- PROCEDURE vi$do_select
- IF vi$select_pos = 0 THEN
- vi$select_pos := SELECT (REVERSE);
- vi$info ("Selection started!");
- ELSE
- vi$select_pos := 0;
- vi$info ("Selection canceled!");
- ENDIF;
- RETURN (1);
- ENDPROCEDURE;
-
- !
- ! Perform the EX mode fill command.
- !
- PROCEDURE vi$do_fill (cmd, i, whole_range, olen)
- LOCAL
- separ,
- token_1,
- token_2;
-
- token_1 := vi$skip_separ (cmd, i, vi$_space_tab, separ);
- token_2 := vi$skip_separ (cmd, i, vi$_space_tab, separ);
- IF token_1 = "" THEN
- token_1 := 0;
- ELSE
- token_1 := INT (token_1);
- ENDIF;
-
- IF token_2 = "" THEN
- token_2 := 0;
- ELSE
- token_2 := INT (token_2);
- ENDIF;
-
- IF (vi$select_pos <> 0) THEN
- cmd := SELECT_RANGE;
- IF (cmd = 0) THEN
- vi$info ("Nothing selected!");
- RETURN (1);
- ENDIF;
- vi$select_pos := 0;
- vi$fill_region (token_1, token_2, cmd);
- MESSAGE ("");
- ELSE
- vi$fill_region (token_1, token_2, whole_range);
- ENDIF;
-
- vi$info ("Fill complete!");
- sleep (1);
- vi$check_length (olen);
- RETURN (0);
- ENDPROCEDURE;
-
- !
- ! Perform the EX mode upper, lower, and insert commands.
- !
- PROCEDURE vi$do_case (token_1, whole_range)
- LOCAL
- rng,
- mode,
- pos,
- cmd;
-
- IF (vi$select_pos <> 0) THEN
- rng := SELECT_RANGE;
- vi$select_pos := 0;
- mode := VI$IN_LINE_MODE;
- vi$update (CURRENT_WINDOW);
- ELSE
- rng := whole_range;
- mode := VI$LINE_MODE;
- ENDIF;
-
- cmd := UPPER;
- IF SUBSTR (token_1, 1, 1) = "l" THEN
- cmd := LOWER;
- ELSE
- IF (SUBSTR (token_1, 1, 1) = "i") THEN
- cmd := INVERT;
- ENDIF;
- ENDIF;
-
- vi$undo_start := BEGINNING_OF (rng);
- vi$undo_end := END_OF (rng);
- pos := MARK (NONE);
- POSITION (BEGINNING_OF (rng));
- vi$save_for_undo (rng, mode, 1);
- POSITION (pos);
- CHANGE_CASE (rng, cmd);
- rng := 0;
- RETURN (0);
- ENDPROCEDURE;
-
- !
- ! Perform the EX mode delete command.
- !
- PROCEDURE vi$do_delete (start_mark, whole_range, olen)
- POSITION (start_mark);
- IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
- MOVE_HORIZONTAL (-1);
- vi$undo_start := MARK (NONE);
- ELSE
- vi$undo_start := 0;
- ENDIF;
-
- vi$save_for_undo (whole_range, VI$LINE_MODE, 1);
- vi$undo_end := 0;
- ERASE (whole_range);
- IF (vi$undo_start <> 0) THEN
- POSITION (vi$undo_start);
- MOVE_HORIZONTAL (1);
- vi$undo_start := MARK (NONE);
- ELSE
- vi$undo_start := BEGINNING_OF (CURRENT_BUFFER);
- ENDIF;
- vi$check_length (olen);
- RETURN (0);
- ENDPROCEDURE;
-
- !
- ! Perform the EX mode write command.
- !
- PROCEDURE vi$do_write (cmd, i, no_spec, token_1, whole_range)
- LOCAL
- range_used,
- outf,
- res_spec,
- ncmd,
- buf,
- win,
- owin,
- bang,
- proc,
- token_2;
-
- ON_ERROR
- IF ERROR = TPU$_PARSEFAIL THEN
- vi$info ("Don't understand filename, '"+token_2+"'");
- RETURN (1);
- ENDIF;
- ENDON_ERROR;
-
- bang := vi$parse_next_ch (i, cmd, "!");
- vi$skip_white (cmd, i);
-
- IF (vi$parse_next_ch (i, cmd, "!")) THEN
- buf := vi$init_buffer ("$$filt_temp$$", "");
- win := CREATE_WINDOW (1, vi$scr_length-1, ON);
- owin := CURRENT_WINDOW;
- IF (buf = 0) OR (win = 0) THEN
- vi$info ("Can't get buffer and window for command!");
- RETURN (1);
- ENDIF;
-
- SET (STATUS_LINE, win, REVERSE,
- "*Output from command: "+vi$rest_of_line (cmd,i));
- MAP (win, buf);
- UPDATE (win);
- vi$pasthru_off;
- proc := CREATE_PROCESS (buf, vi$rest_of_line (cmd, i));
- IF proc <> 0 THEN
- SEND (whole_range, proc);
- IF proc <> 0 THEN
- SEND_EOF (proc);
- ENDIF;
- ENDIF;
- UPDATE (win);
- vi$info ("[Hit RETURN to continue]");
- LOOP
- EXITIF vi$read_a_key = RET_KEY;
- ENDLOOP;
-
- vi$pasthru_on;
- UNMAP (win);
- DELETE (win);
- DELETE (buf);
- POSITION (owin);
- RETURN (1);
- ENDIF;
-
- range_used := 0;
- IF (no_spec) AND (vi$select_pos <> 0) THEN
- whole_range := SELECT_RANGE;
- no_spec := 0;
- range_used := 1;
- ENDIF;
-
- vi$skip_white (cmd, i);
- ncmd := vi$rest_of_line (cmd, i);
- vi$process_special (ncmd, token_2);
-
- IF (token_2 <> "") THEN
- res_spec := FILE_PARSE (token_2);
-
- outf := FILE_SEARCH ("");
- outf := FILE_SEARCH (res_spec);
- IF (outf <> "") AND
- (outf <> GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE")) AND
- NOT bang THEN
- vi$info (token_2 +
- ' exists - use "' +
- token_1 +
- '! ' +
- token_2 +
- '" to overwrite.');
- RETURN (1);
- ELSE
- vi$info ("Writing out """+res_spec+"""");
- IF (no_spec = 0) THEN
- WRITE_FILE (whole_range, res_spec);
- ELSE
- WRITE_FILE (CURRENT_BUFFER, res_spec);
- ENDIF;
- ENDIF;
- ELSE
- IF (no_spec = 0) THEN
- IF bang THEN
- vi$info ('Use "w!" to write partial buffer');
- outf := "";
- ELSE
- outf := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE");
- IF outf <> "" THEN
- vi$info ("Writing out """+outf+"""");
- outf := WRITE_FILE (whole_range, outf);
- ELSE
- vi$info ("Buffer has no output file!");
- ENDIF;
- ENDIF;
- ELSE
- IF (vi$can_write (CURRENT_BUFFER)) THEN
- vi$info ("Writing out """+
- GET_INFO (CURRENT_BUFFER, "NAME")+"""");
- outf := WRITE_FILE (CURRENT_BUFFER);
- ELSE
- RETURN;
- ENDIF
- ENDIF;
-
- IF (outf <> "") THEN
- SET (OUTPUT_FILE, CURRENT_BUFFER, outf);
- ENDIF;
- ENDIF;
-
- IF range_used THEN
- vi$select_pos := 0;
- ENDIF;
-
- vi$kill_undo;
- vi$undo_end := 0;
-
- ! Always leave message visible
-
- RETURN (1);
- ENDPROCEDURE;
-
- !
- ! Check to see if a buffer is readonly or not.
- !
- PROCEDURE vi$can_write (buf)
- LOCAL
- bmode;
-
- bmode := vi$getbufmode (buf);
- IF (bmode) THEN
- vi$info (FAO ("!AS is set readonly", GET_INFO (buf, "NAME")));
- ENDIF;
-
- RETURN (bmode = 0);
- ENDPROCEDURE;
-
- !
- ! Perform the EX mode read command.
- !
- PROCEDURE vi$do_read (cmd, i, start_line, olen)
- LOCAL
- outf,
- spos,
- epos,
- ret,
- token_2,
- token_3;
-
- token_3 := vi$rest_of_line (cmd, i);
- vi$process_special (token_3, token_2);
- i := 1;
- vi$skip_white (token_3, i);
- IF (vi$parse_next_ch (i, token_3, "!")) THEN
- POSITION (LINE_BEGIN);
- vi$move_vertical (1);
- SPLIT_LINE;
- MOVE_HORIZONTAL (-1);
- vi$kill_undo;
- epos := MARK (NONE);
- spos := MARK (NONE);
- vi$undo_start := vi$get_undo_start;
- ret := vi$filter_region (CREATE_RANGE (spos, epos, NONE),
- vi$rest_of_line (token_3, i));
- MOVE_HORIZONTAL (-1);
- vi$undo_end := MARK (NONE);
- vi$undo_start := vi$set_undo_start (vi$undo_start);
- POSITION (vi$undo_start);
- RETURN (ret);
- ENDIF;
-
- token_3 := vi$rest_of_line (cmd, i);
- vi$process_special (token_3, token_2);
-
- IF (token_2 <> "") THEN
- token_2 := FILE_PARSE (token_2);
- outf := FILE_SEARCH ("");
- outf := FILE_SEARCH (token_2);
- IF (outf <> "") THEN
- IF (start_line > 0) THEN
- POSITION (BEGINNING_OF (CURRENT_BUFFER));
- MOVE_VERTICAL (start_line - 1);
- ENDIF;
- POSITION (LINE_BEGIN);
- IF (MARK (NONE) = END_OF (CURRENT_BUFFER)) THEN
- SPLIT_LINE;
- ELSE
- MOVE_VERTICAL (1);
- ENDIF;
- MOVE_HORIZONTAL (-1);
- spos := MARK (NONE);
- MOVE_HORIZONTAL (1);
- outf := READ_FILE (outf);
- IF (outf <> "") THEN
- MOVE_HORIZONTAL (-1);
- vi$undo_end := MARK (NONE);
- vi$kill_undo;
- POSITION (spos);
- MOVE_HORIZONTAL (1);
- vi$undo_start := MARK (NONE);
- ENDIF;
- ELSE
- vi$info (token_2 + " does not exist!");
- ENDIF;
- ELSE
- vi$info ("Filename required!");
- ENDIF;
- vi$check_length (olen);
-
- ! Always leave last message visible
-
- RETURN (1);
- ENDPROCEDURE;
-
- !
- ! Perform the EX mode file command.
- !
- PROCEDURE vi$do_file_ex (cmd, i)
- LOCAL
- token_2;
-
- ON_ERROR
- IF ERROR = TPU$_PARSEFAIL THEN
- vi$info ("Don't understand filename: "+token_2);
- ENDIF;
- ENDON_ERROR;
-
- token_2 := vi$rest_of_line (cmd, i);
- IF (token_2 <> "") THEN
- token_2 := FILE_PARSE (token_2);
- SET (OUTPUT_FILE, CURRENT_BUFFER, token_2);
- vi$status_lines (CURRENT_BUFFER);
- ENDIF;
- vi$what_line;
-
- RETURN (1);
- ENDPROCEDURE;
-
- !
- ! Perform the EX mode buffer command.
- !
- PROCEDURE vi$do_buffer (cmd, i, token_1)
-
- LOCAL
- buf,
- cbuf,
- bang,
- separ,
- token_2,
- token_3;
-
- ON_ERROR
- IF ERROR = TPU$_PARSEFAIL THEN
- vi$info ("Don't understand filename given!");
- RETURN (1);
- ENDIF;
- ENDON_ERROR;
-
- bang := vi$parse_next_ch (i, cmd, "!");
- buf := 0;
- cbuf := CURRENT_BUFFER;
-
- token_2 := vi$skip_separ (cmd, i, vi$_space_tab, separ);
- token_3 := vi$skip_separ (cmd, i, vi$_space_tab, separ);
-
- IF (vi$rest_of_line (cmd, i) <> "") THEN
- vi$info ("Too many paramters!");
- RETURN (1);
- ENDIF;
-
- IF (token_2 <> "") THEN
- IF (token_3 = "") THEN
- buf := vi$find_buffer_by_name (token_2);
- IF buf = 0 THEN
- buf := vi$_create_buffer (token_2, 0, 0);
- ENDIF;
- ELSE
- token_3 := FILE_PARSE (token_3);
- buf := vi$_create_buffer (token_2, token_3, token_3);
- ENDIF;
-
- IF (buf <> 0) THEN
- POSITION (cbuf);
- IF (vi$check_auto_write) THEN
- RETURN;
- ENDIF;
- MAP (CURRENT_WINDOW, buf);
- vi$set_status_line (CURRENT_WINDOW);
- ENDIF;
- ELSE
- vi$what_line;
- ENDIF;
-
- vi$kill_undo;
- vi$undo_end := 0;
- RETURN (1);
- ENDPROCEDURE;
-
- !
- ! Perform the EX mode "vi" and/or "edit" commands.
- !
- PROCEDURE vi$do_edit (cmd, i, token_1)
- LOCAL
- buf,
- bang,
- num,
- look,
- ch,
- endch,
- token_2;
-
- num := -1;
- look := -1;
-
- bang := vi$parse_next_ch (i, cmd, "!");
- vi$skip_white (cmd, i);
- IF vi$parse_next_ch (i, cmd, "+") THEN
- ! Get a goto spec.
- IF vi$parse_next_ch (i, cmd, "/") THEN
- ! Get a search string
- look := "";
- IF vi$parse_next_ch (i, cmd, '"') THEN
- endch := '"';
- ELSE
- endch := " ";
- ENDIF;
- LOOP
- ch := vi$next_char (cmd, i);
- EXITIF (endch = ch) OR (ch = "");
- IF (ch = "/") THEN
- ch := vi$next_char (cmd, i);
- IF ch <> '"' THEN
- ch := "/" + ch;
- ENDIF;
- ENDIF;
- look := look + ch;
- ENDLOOP;
- vi$skip_white (cmd, i);
- ELSE
- ! Get a number
- num := "";
- LOOP
- EXITIF INDEX (vi$_numeric_chars, SUBSTR (cmd, i, 1)) = 0;
- num := num + vi$next_char (cmd, i);
- ENDLOOP;
- vi$skip_white (cmd, i);
- num := INT (num);
- ENDIF;
- ENDIF;
- token_2 := vi$rest_of_line (cmd, i);
-
- ! Check for use of % as file name, this means current file, so it is
- ! synonomous with specifying no filename.
-
- IF (token_2 = "") OR (token_2 = "%") THEN
- IF (NOT bang) AND (GET_INFO (CURRENT_BUFFER, "MODIFIED")) THEN
- vi$info ("No write since last change, use """ +
- token_1 + "!"" to override");
- RETURN (1);
- ENDIF;
-
- token_2 := GET_INFO (CURRENT_BUFFER, "FILE_NAME");
- IF (token_2 = 0) OR (token_2 = "") THEN
- vi$info ("Buffer has no file!");
- RETURN (1);
- ENDIF;
-
- ! Get everything but the version.
-
- token_2 := FILE_PARSE (token_2, "", "", DEVICE) +
- FILE_PARSE (token_2, "", "", DIRECTORY) +
- FILE_PARSE (token_2, "", "", NAME) +
- FILE_PARSE (token_2, "", "", TYPE);
-
- buf := CURRENT_BUFFER;
- MAP (CURRENT_WINDOW, MESSAGE_BUFFER);
- POSITION (MESSAGE_BUFFER);
- DELETE (buf);
- ENDIF;
-
- ! Check for abbreviation for previous file, and just swap buffers if
- ! that is the case.
-
- IF (token_2 = "#") THEN
- vi$move_prev_buf (bang);
- ELSE
- vi$get_file (token_2);
- vi$pos_in_middle (MARK (NONE));
- vi$kill_undo;
- vi$undo_end := 0;
- ENDIF;
- IF (num <> -1) THEN
- vi$move_to_line (num);
- vi$pos_in_middle (MARK (NONE));
- ELSE
- IF (look <> -1) THEN
- vi$search_string := look;
- num := vi$find_str (look, 0, 0);
- IF (num <> 0) THEN
- vi$beep_position (num, 1, 1);
- vi$pos_in_middle (MARK (NONE));
- ENDIF;
- ENDIF;
- ENDIF;
- RETURN (1);
- ENDPROCEDURE;
-
- !
- ! Perform the EX mode messages command.
- !
- PROCEDURE vi$do_messages
- vi$last_mapped := CURRENT_BUFFER;
- MAP (CURRENT_WINDOW, MESSAGE_BUFFER);
- POSITION (MESSAGE_BUFFER);
- vi$set_status_line (CURRENT_WINDOW);
- vi$kill_undo;
- vi$undo_end := 0;
- RETURN (0);
- ENDPROCEDURE;
-
- !
- ! Perform the EX mode tag command.
- !
- PROCEDURE vi$do_tag (tag_str, bang);
- vi$load_tags;
- RETURN (vi$to_tag (tag_str, bang));
- ENDPROCEDURE;
-
- !
- ! Load the tags files into a buffer
- !
- PROCEDURE vi$load_tags
- LOCAL
- idx,
- fname,
- ch,
- flist,
- pos;
-
- ON_ERROR
- ENDON_ERROR;
-
- pos := MARK (NONE);
- ERASE (vi$tag_buf);
-
- POSITION (BEGINNING_OF (vi$tag_buf));
- idx := 0;
- fname := "";
-
- flist := vi$tag_files + " ";
- LOOP
- EXITIF (idx > LENGTH(flist));
- ch := SUBSTR (flist, idx, 1);
- IF (INDEX (vi$_space_tab, ch) <> 0) AND (fname <> "") THEN
- vi$info_success_off;
- fname := FILE_PARSE (fname);
- IF (fname <> "") AND (FILE_SEARCH (fname) <> "") THEN
- READ_FILE (FILE_PARSE (fname));
- ENDIF;
- vi$info_success_on;
- fname := "";
- ELSE
- IF (INDEX (vi$_space_tab, ch) = 0) THEN
- fname := fname + ch;
- ENDIF;
- ENDIF;
- idx := idx + 1;
- ENDLOOP;
-
- POSITION (pos);
- RETURN (0);
- ENDPROCEDURE;
-
- !
- ! Position to the tag given or use the current symbol in the buffer
- !
- PROCEDURE vi$to_tag (tag, bang)
- LOCAL
- fname,
- sch_pat,
- tloc,
- pos;
-
- ON_ERROR
- ENDON_ERROR;
-
- pos := MARK (NONE);
-
- ! Read the symbol name from the CURRENT location in the buffer.
-
- IF (tag = 0) THEN
- tag := vi$sym_name;
- ENDIF;
-
- IF (tag = "") THEN
- vi$info ("Bad tag name");
- POSITION (pos);
- RETURN (1);
- ENDIF;
-
- POSITION (BEGINNING_OF (vi$tag_buf));
- IF (MARK (NONE) = END_OF (vi$tag_buf)) THEN
- vi$info ("NO tags file!");
- POSITION (pos);
- RETURN (1);
- ENDIF;
-
- vi$global_var := 0;
- EXECUTE (COMPILE ("vi$global_var := LINE_BEGIN & '"+tag+ASCII(9)+"'"));
-
- vi$info_success_off;
- tloc := SEARCH (vi$global_var, FORWARD, vi$tag_case);
- vi$info_success_on;
-
- IF (tloc <> 0) THEN
- POSITION (END_OF (tloc));
- MOVE_HORIZONTAL (1);
- fname := vi$space_word;
- sch_pat := SUBSTR (CURRENT_LINE, CURRENT_OFFSET+2, 1024);
- POSITION (pos);
-
- IF (NOT bang) AND (vi$check_auto_write) THEN
- RETURN (1);
- ENDIF;
-
- IF (vi$get_file (fname) > 0) THEN
- POSITION (END_OF (CURRENT_BUFFER));
- IF (vi$do_cmd_line (sch_pat)) THEN
- POSITION (BEGINNING_OF (CURRENT_BUFFER));
- vi$info ("Tag not found!");
- $$EOD$$
-