Usenet 1994 October/usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso/misc/volume4/vms-vi-2/part12

Internet Message Format | 1989-02-03 | 37.4 KB

Path: xanth!mcnc!gatech!bloom-beacon!bu-cs!mirror!necntc!ncoast!allbery
From: [e-mail] (Gregg Wonderly)
Newsgroups: comp.sources.misc
Subject: v04i103: TPUVI for VMS part 12 of 17
Message-ID: <[e-mail]>
Date: 27 Sep 88 01:57:50 GMT
Sender: [e-mail]
Reply-To: [e-mail] (Gregg Wonderly)
Lines: 1503
Approved: [e-mail]

Posting-number: Volume 4, Issue 103
Submitted-by: "Gregg Wonderly" <[e-mail]>
Archive-name: vms-vi-2/Part12

$ WRITE SYS$OUTPUT "Creating ""VI.8"""
$ CREATE VI.8
$ DECK/DOLLARS=$$EOD$$
                RETURN (1);
            ENDIF;
            vi$pos_in_middle (MARK (NONE));
        ENDIF;
    ELSE
        POSITION (pos);
        vi$info ("Tag not in tags file");
        RETURN (1);
    ENDIF;
    RETURN (0);
ENDPROCEDURE;

!
!   Return the word that is spanned by characters in the symbol set.
!
PROCEDURE vi$sym_name
    LOCAL
        ch;

    ch := "";
    LOOP
        EXITIF INDEX (vi$_sym_chars, CURRENT_CHARACTER) = 0;
        ch := ch + CURRENT_CHARACTER;
        MOVE_HORIZONTAL (1);
    ENDLOOP;
    RETURN (ch);
ENDPROCEDURE;

!
!   Return the word that is spanned by non-blank characters.
!
PROCEDURE vi$space_word
    LOCAL
        ch;

    ch := "";
    LOOP
        EXITIF (CURRENT_CHARACTER = " ") OR (CURRENT_CHARACTER = ASCII (9));
        ch := ch + CURRENT_CHARACTER;
        MOVE_HORIZONTAL (1);
    ENDLOOP;
    RETURN (ch);
ENDPROCEDURE;

!
!   Perform the EX mode tpu command.
!
PROCEDURE vi$do_tpu (cmd, i, no_spec, whole_range)

    ON_ERROR
        RETURN (1);
    ENDON_ERROR;

    IF no_spec AND (vi$rest_of_line (cmd, i) <> "") THEN
        EXECUTE (COMPILE (vi$rest_of_line (cmd, i)));
    ELSE
        vi$info ("Compiling...");
        IF no_spec AND (vi$rest_of_line (cmd, i) = "") THEN
            IF (vi$select_pos <> 0) THEN
                EXECUTE (COMPILE (SELECT_RANGE));
                vi$select_pos := 0;
                MESSAGE ("");
            ELSE
                vi$info ("Nothing selected to compile!");
                RETURN (1);
            ENDIF;
        ELSE
            COMPILE (whole_range);
        ENDIF;
    ENDIF;

    RETURN (1);
ENDPROCEDURE;

!
!
!
PROCEDURE vi$do_wq (cmd, i, no_spec, token_1, whole_range)
    vi$do_write (cmd, i, no_spec, token_1, whole_range);
    vi$do_quit (cmd, token_1);
    RETURN (1);
ENDPROCEDURE;
!
!   Perform the EX mode quit command.
!
PROCEDURE vi$do_quit (cmd, token_1)
    LOCAL
        buf;

    buf := GET_INFO (BUFFERS, "FIRST");
    LOOP
        EXITIF buf = 0;
        IF GET_INFO (buf, "MODIFIED") AND
                                        (NOT GET_INFO (buf, "SYSTEM")) THEN
            IF NOT GET_INFO (buf, "NO_WRITE") THEN
                IF INDEX (cmd, "!") <> 0 THEN
                    SET (NO_WRITE, buf);
                ELSE
                    vi$info ("No write of buffer """+GET_INFO (buf, "NAME") +
                             """ since last change, use """+token_1 +
                             "!"" to override.");
                    RETURN (1);
                ENDIF;
            ENDIF;
        ENDIF;
        buf := GET_INFO (BUFFERS, "NEXT");
    ENDLOOP;
    vi$quit;
    RETURN (1);
ENDPROCEDURE;

!
!  Delete the buffer given by the name passed as the parameter.  The buffer
!  must not be the current buffer, or if it is, there must be more than
!  one buffer on the screen.
!
PROCEDURE vi$do_delbuf (cmd, i)

    LOCAL
        win,
        confirm,
        possible_buffer,
        possible_buffer_name,
        found_a_buffer,
        how_many_buffers,
        this_buffer,
        loop_buffer,
        bang,
        buffer_name;

    ! Get the buffer name, solving abiguity problems.

    bang := vi$parse_next_ch (i, cmd, "!");
    vi$skip_white (cmd, i);
    buffer_name := vi$rest_of_line (cmd, i);
    CHANGE_CASE (buffer_name, UPPER);   ! for messages
    loop_buffer := vi$find_buffer_by_name (buffer_name);

    IF (loop_buffer <> 0) THEN
        buffer_name := GET_INFO (loop_buffer, "NAME");

        ! Now, we must first delete all windows mapped to this buffer.

        win := GET_INFO (WINDOWS, "FIRST");
        LOOP
            EXITIF (win = 0);
            EXITIF (GET_INFO (loop_buffer, "MAP_COUNT") = 0);

            ! See if current window is mapped to this buffer.

            IF (GET_INFO (win, "BUFFER") = loop_buffer) THEN

                ! If so, there must be a previous or a next window to move to.
                ! If there is not, then we can not delete the buffer until
                ! another buffer (and window) are available to move to.

                IF (vi$prev_win (win) <> 0) OR (vi$next_win(win) <> 0) THEN
                    POSITION (win);
                    vi$del_win (win);

                    ! Restart at beginning of list.  Deleting a window will
                    ! make "NEXT" not work.

                    win := GET_INFO (WINDOWS, "FIRST");
                ELSE
                    vi$info ("Can't unmap all windows that are mapped to """ +
                                                        buffer_name + """!");
                    RETURN (1);
                ENDIF;
            ELSE
                win := GET_INFO (WINDOWS, "NEXT");
            ENDIF;
        ENDLOOP;
    ELSE
        vi$info ("No such buffer, "+buffer_name);
        RETURN (1);
    ENDIF;

    CHANGE_CASE (buffer_name, UPPER);
    IF (GET_INFO (loop_buffer, "MAP_COUNT") = 0) THEN
        IF (GET_INFO (loop_buffer, "MODIFIED") AND NOT bang) THEN
            confirm := READ_LINE ("Delete modified buffer, """+
                                                        buffer_name+"""? ");

            EDIT (confirm, UPPER);
            IF (SUBSTR (confirm, 1, 1) <> "Y") THEN
                vi$info ("Buffer NOT deleted!");
                RETURN (1);
            ENDIF;
        ENDIF;

        DELETE (loop_buffer);
        vi$info ("Buffer, """+buffer_name+""", deleted!");
    ELSE
        vi$info ("Can't delete """+buffer_name+
                                        """, it is still mapped to a window!");
        RETURN (1);
    ENDIF;

!   Normally we would return 0, but the above message must remain visible.

    RETURN (1);
ENDPROCEDURE;
!
!   Return the proper value of a MARKER that indicates the previous position
!   in the current buffer.
!
PROCEDURE vi$get_undo_start
    LOCAL
        pos;

    IF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) THEN
        RETURN (0);
    ELSE
        MOVE_HORIZONTAL (-1);
        pos := MARK (NONE);
        MOVE_HORIZONTAL (1);
        RETURN (pos);
    ENDIF;
ENDPROCEDURE;

!
!   Use "spos" to determine where "vi$undo_start" should be set.
!
PROCEDURE vi$set_undo_start (spos)
    IF spos = 0 THEN
        RETURN (BEGINNING_OF (CURRENT_BUFFER));
    ELSE
        POSITION (spos);
        MOVE_HORIZONTAL (1);
        RETURN (MARK (NONE));
    ENDIF;
ENDPROCEDURE;

!
!  If this was real VI under UNIX, all you would need to do is filter text
!  through NROFF...  sigh...  I guess you can't have it all?
!
PROCEDURE vi$fill_region (leftm, rightm, rng)
    LOCAL
        pos,
        tend,
        spos,
        beg;

    IF (leftm = 0) THEN
        leftm := 1;
    ENDIF;

    IF (rightm = 0) THEN
        rightm := vi$scr_width - vi$wrap_margin;
    ENDIF;

    POSITION (BEGINNING_OF (rng));
    LOOP
        EXITIF (CURRENT_CHARACTER <> " ") AND (CURRENT_CHARACTER <> ASCII (9));
        MOVE_HORIZONTAL (1);
        EXITIF (MARK (NONE) = END_OF (rng));
    ENDLOOP;

    beg := MARK (NONE);
    POSITION (END_OF (rng));
    MOVE_HORIZONTAL (-1);
    tend := MARK (NONE);
    rng := CREATE_RANGE (beg, tend, NONE);
    POSITION (BEGINNING_OF (rng));
    vi$save_for_undo (rng, VI$IN_LINE_MODE, 1);
    spos := vi$get_undo_start;

    FILL (rng, " ", leftm, rightm);
    vi$undo_end := MARK (NONE);
    vi$undo_start := vi$set_undo_start (spos);
    POSITION (vi$undo_start);
ENDPROCEDURE;

!
!   Given a buffer name, return the buffer TYPE variable for that buffer.
!
PROCEDURE vi$find_buffer_by_name (bname_param)
    LOCAL
        cnt,
        bname,
        possible,
        pbuf,
        buf;

    bname := bname_param;
    CHANGE_CASE (bname, UPPER);
    buf := GET_INFO (BUFFERS, "FIRST");
    cnt := 0;

    LOOP
        EXITIF buf = 0;
        possible := GET_INFO (buf, "NAME");
        EXITIF bname = possible;
        IF vi$leading_str (bname, possible) THEN
            cnt := cnt + 1;
            pbuf := buf;
        ENDIF;
        buf := GET_INFO (BUFFERS, "NEXT");
    ENDLOOP;

    IF buf = 0 THEN
        IF cnt = 1 THEN
            buf := pbuf;
        ENDIF;
    ENDIF;

    RETURN (buf);
ENDPROCEDURE;

!
!   Effect a key mapping, and squirl away the original mapping so that
!   it can be restore later.
!
PROCEDURE vi$map_keys (cmd, i)
    LOCAL
        comment_string,
        separ,
        pos,
        buf,
        map_type,
        keyn,
        key;

    map_type := vi$cmd_keys;
    IF (vi$parse_next_ch (i, cmd, "!")) THEN
        map_type := vi$edit_keys;
    ENDIF;

    IF SUBSTR (cmd, i, 1) <> " " THEN
        vi$show_maps;
        RETURN(1);
    ENDIF;

    vi$skip_white (cmd, i);

    IF (i > LENGTH (cmd)) THEN
        vi$show_maps;
        RETURN (1);
    ENDIF;

    key := KEY_NAME (SUBSTR (cmd, i, 1));
    i := i + 1;
    comment_string := LOOKUP_KEY (key, COMMENT, map_type);

    vi$skip_white (cmd, i);

    key := INT (key);
    IF (key < 32) THEN
        key := ((INT(CTRL_B_KEY) - INT(CTRL_A_KEY)) *
                                        (key - 1)) + INT(CTRL_A_KEY);
    ENDIF;

    keyn := vi$key_map_name (key);

    IF (map_type = vi$edit_keys) AND (comment_string <> 0) AND
            (comment_string <> "") AND (comment_string <> "active_macro") THEN
        vi$info ("You can't redefine that key!");
        RETURN (1);
    ENDIF;

    vi$global_var := 0;
    buf := 0;

    ! The callable TPU interface can create certain problems, as it
    ! may cause the key definitions to hang around when the map
    ! buffers have actually been deleted.  Mail can do this!  As a
    ! result, the following code detects when the map buffer is
    ! missing, and creates a new one.  The original meaning of
    ! any key that is mapped in this way is necessarily lost.

    IF comment_string = "active_macro" THEN
        EXECUTE (COMPILE ("vi$global_var := vi$$key_map_buf_" +
                            keyn + map_type + ";"));
        buf := vi$global_var;

        ! If buf is zero at this point, then the key map buffer
        ! has been deleted.

    ELSE
        EXECUTE (COMPILE (
            "vi$global_var := vi$init_buffer ('vi$$key_map_" +
                                                keyn + map_type + "', '');"));

        IF (vi$global_var = 0) THEN
            vi$info ("Can't create buffer for key map!");
            RETURN;
        ENDIF;

        EXECUTE (COMPILE ("vi$$key_map_buf_" +
                                    keyn + map_type + " := vi$global_var;"));

        ! Pass the flag.

        buf := 1;
    ENDIF;

    ! New key map, save old map into keymap buffer.

    IF (GET_INFO (buf, "TYPE") = INTEGER) THEN
        buf := vi$global_var;
        pos := MARK (NONE);
        POSITION (buf);
        SPLIT_LINE;
        COPY_TEXT (comment_string);
    ELSE

        ! Old map should be erased first.

        IF (GET_INFO (buf, "TYPE") = BUFFER) THEN
            pos := MARK (NONE);
            POSITION (BEGINNING_OF (buf));
            LOOP
                EXITIF (CURRENT_LINE = "");
                ERASE_LINE;
            ENDLOOP;
        ELSE

            ! Key map buffer has been deleted, create a new one.

            EXECUTE (COMPILE (
                "vi$global_var := vi$init_buffer ('vi$$key_map_" +
                                                keyn + map_type + "', '');"));

            IF (vi$global_var = 0) THEN
                vi$info ("Can't create buffer for key map!");
                RETURN;
            ENDIF;

            EXECUTE (COMPILE ("vi$$key_map_buf_" +
                                    keyn + map_type + " := vi$global_var;"));
            buf := vi$global_var;
            pos := MARK (NONE);
            POSITION (buf);
            SPLIT_LINE;
            COPY_TEXT ("vi$lost_definition");
        ENDIF;
    ENDIF;

    POSITION (BEGINNING_OF (buf));

    LOOP
        EXITIF (i > LENGTH (cmd));
        COPY_TEXT (STR (INT (KEY_NAME (SUBSTR (cmd, i, 1)))));
        SPLIT_LINE;
        i := i + 1;
    ENDLOOP;

    POSITION (BEGINNING_OF (buf));
    POSITION (pos);

    vi$info_success_off;

    IF (map_type = vi$edit_keys) THEN
        EXECUTE (COMPILE
            ("DEFINE_KEY ('vi$insert_macro_keys (vi$$key_map_buf_" + keyn +
            map_type + ")', KEY_NAME(" + STR(key) + "), 'active_macro', vi$edit_keys);"));
    ELSE
        EXECUTE (COMPILE ("DEFINE_KEY ('vi$do_macro (vi$$key_map_buf_" + keyn +
            map_type + ", 1)', KEY_NAME(" + STR(key) +
            "), 'active_macro', vi$cmd_keys);"));
    ENDIF;

    vi$info_success_on;
    RETURN (0);
ENDPROCEDURE;

!
!   Unmap a key mapping and restore the original if one existed.
!
PROCEDURE vi$unmap_keys (cmd, i)
    LOCAL
        comment_string,
        separ,
        pos,
        buf,
        map_type,
        keyn,
        key;

    map_type := vi$cmd_keys;
    IF (SUBSTR (cmd, i, 1) = "!") THEN
        map_type := vi$edit_keys;
        i := i + 1;
    ELSE
        IF SUBSTR (cmd, i, 1) <> " " THEN
            vi$info ("Bad command!");
            RETURN;
        ENDIF;
    ENDIF;

    vi$skip_white (cmd, i);

    key := KEY_NAME (SUBSTR (cmd, i ,1));

    comment_string := LOOKUP_KEY (key, COMMENT, map_type);

    IF comment_string <> "active_macro" THEN
        vi$info ("Key not currently mapped!");
        RETURN;
    ENDIF;

    key := INT (key);
    IF (key < 32) THEN
        key := ((INT(CTRL_B_KEY) - INT(CTRL_A_KEY)) *
                                        (key - 1)) + INT(CTRL_A_KEY);
    ENDIF;

    keyn := vi$key_map_name (key);

    vi$global_var := 0;
    EXECUTE (COMPILE ("vi$global_var := vi$$key_map_buf_" +
                                                    keyn + map_type + ";"));
    buf := vi$global_var;

    pos := MARK (NONE);
    POSITION (END_OF (buf));
    MOVE_VERTICAL (-1);

    vi$info_success_off;
    EXECUTE (COMPILE ("DEFINE_KEY ('"+CURRENT_LINE +
        "', "+STR(key)+", '"+CURRENT_LINE+"', '" + map_type + "')"));
    vi$info_success_on;

    POSITION (pos);
    DELETE (buf);

    vi$info ("Key now unmapped!");
ENDPROCEDURE;

!
!
!
PROCEDURE vi$lost_definition
    vi$info ("Key definition lost!");
ENDPROCEDURE;

!
!   Show current keyboard mappings.
!
PROCEDURE vi$show_maps
    LOCAL
        com,
        key_type,
        keyn,
        key,
        bpos,
        npos,
        pos,
        buf;

    pos := MARK (NONE);
    buf := choice_buffer;

    POSITION (buf);
    ERASE (buf);

    key_type := vi$cmd_keys;
    COPY_TEXT ("COMMAND KEY MAPS:");
    SPLIT_LINE;
    LOOP
        keyn := GET_INFO (DEFINED_KEY, "first", key_type);
        LOOP
            EXITIF (keyn = 0);
            com := LOOKUP_KEY (keyn, COMMENT, key_type);

            IF (com = "active_macro") THEN
                key := vi$key_map_name (keyn);
                vi$global_var := 0;
                EXECUTE (COMPILE ("vi$global_var:=vi$$key_map_buf_"+
                                                            key+key_type));
                IF (vi$global_var <> 0) AND
                        (GET_INFO (vi$global_var, "TYPE") = BUFFER) THEN
                    key := vi$ascii_name (keyn);
                    COPY_TEXT (" "+key+SUBSTR ("   ", 1, 4-LENGTH(key))+'"');
                    npos := MARK (NONE);
                    POSITION (BEGINNING_OF (vi$global_var));
                    LOOP
                        keyn := CURRENT_LINE;
                        EXITIF (LENGTH (keyn) < 8);
                        bpos := MARK (NONE);
                        POSITION (npos);
                        COPY_TEXT (vi$ascii_name (INT(keyn)));
                        POSITION (bpos);
                        MOVE_VERTICAL (1);
                    ENDLOOP;
                    POSITION (npos);
                    COPY_TEXT ('"');
                    SPLIT_LINE;
                ENDIF;
            ENDIF;
            keyn := GET_INFO (DEFINED_KEY, "next", key_type);
        ENDLOOP;
        EXITIF (key_type = vi$edit_keys);
        key_type := vi$edit_keys;
        SPLIT_LINE;
        COPY_TEXT ("EDITING KEY MAPS:");
        SPLIT_LINE;
    ENDLOOP;

    APPEND_LINE;
    POSITION (BEGINNING_OF (buf));
    POSITION (pos);
    vi$show_list (buf,
        "                                 Current MAPPINGS" +
        "                           ",
        info_window);
    RETURN (0);

ENDPROCEDURE;

!
!   Generate a unique string based on a KEY_NAME value.
!
PROCEDURE vi$key_map_name (key)
    LOCAL
        k;

    k := key;
    IF (GET_INFO (key, "TYPE") = KEYWORD) THEN
        k := INT (key);
    ENDIF;
    RETURN (SUBSTR(FAO("!XL", key),1,6));
ENDPROCEDURE;

!
!   Increment "i" until it is no longer indexing a blank or tab in "cmd".
!
PROCEDURE vi$skip_white (cmd, i)

    LOOP
        EXITIF i > LENGTH (cmd);
        EXITIF (INDEX (vi$_space_tab, SUBSTR(cmd, i, 1)) = 0);
        i := i + 1;
    ENDLOOP;
ENDPROCEDURE;

!
!   Given a string, extract a line specification that is either absolute,
!   relative, or an RE pattern expression.
!
PROCEDURE vi$get_line_spec (idx, cmd)
    LOCAL
        ch,
        sch,
        num;

    num := 0;

    ch := SUBSTR (cmd, idx, 1);

    IF (ch = "/") OR (ch = "?") THEN
        idx := idx + 1;
        sch := ch;
        num := "";
        LOOP
            EXITIF (vi$parse_next_ch (idx, cmd, sch));
            EXITIF (LENGTH (cmd) < idx);
            ch := SUBSTR (cmd, idx, 1);
            IF (ch = "\") THEN
                num := num + SUBSTR (cmd, idx, 2);
                idx := idx + 1;
            ELSE
                num := num + ch;
            ENDIF;
            idx := idx + 1;
        ENDLOOP;

        IF (LENGTH (cmd) < idx - 1) THEN
            vi$info ("Oops, improper expression!");
            RETURN (-1);
        ENDIF;

        ch := SUBSTR (cmd, idx, 1);

        IF sch = "?" THEN
            SET (REVERSE, CURRENT_BUFFER);
        ELSE
            SET (FORWARD, CURRENT_BUFFER);
        ENDIF;

        num := vi$find_str (num, 0, 0);

        IF (num <> 0) THEN
            num := BEGINNING_OF (num);
            POSITION (num);
            num := vi$cur_line_no;
        ELSE
            RETURN (-1);
        ENDIF;
    ELSE
        IF (ch = "'") THEN
            ch := SUBSTR (cmd, idx+1, 1);
            idx := idx + 2;
            vi$global_var := 0;
            EXECUTE (COMPILE ("vi$global_var:=vi$mark_"+ch));
            IF (vi$global_var <> 0) THEN
                POSITION (vi$global_var);
                num := vi$cur_line_no;
            ELSE
                RETURN (-1);
            ENDIF;
        ELSE
            LOOP
                ch := SUBSTR (cmd, idx, 1);
                EXITIF (INDEX (vi$_numeric_chars, ch) = 0);
                IF (num < 0) THEN
                    num := INT (ch);
                ELSE
                    num := num * 10 + INT (ch);
                ENDIF;
                idx := idx + 1;
            ENDLOOP;
        ENDIF;
    ENDIF;

    IF (ch = ".") THEN
        num := vi$cur_line_no;
        idx := idx + 1;
        IF (vi$parse_next_ch (idx, cmd, "+")) THEN
            num := num + vi$get_line_spec (idx, cmd);
        ENDIF;
    ELSE
        IF (ch = "$") THEN
            num := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
            idx := idx + 1;
        ELSE
            IF (ch = "+") THEN
                num := num + vi$get_line_spec (idx, cmd);
            ENDIF;
        ENDIF;
    ENDIF;

    RETURN (num);
ENDPROCEDURE;

!
!   If the character at location "idx" in "cmd" is "try", then increment
!   "idx" and return TRUE, otherwise return FALSE.
!
PROCEDURE vi$parse_next_ch (idx, cmd, try)
    IF (SUBSTR (cmd, idx, 1) = try) THEN
        idx := idx + 1;
        RETURN (1);
    ENDIF;

    RETURN (0);
ENDPROCEDURE;

!
!   A function to get the string, in "cmd", that is spanned by the characters
!   in "mask".  "idx" is incremented to point past this string, and the string
!   is returned as the function value.
!
PROCEDURE vi$get_cmd_token (mask, cmd, idx)
    LOCAL
        token,
        ch;

    token := "";

    vi$skip_white (cmd, idx);

    LOOP
        EXITIF (idx > LENGTH (cmd));
        ch := SUBSTR (cmd, idx, 1);
        EXITIF (INDEX (mask, ch) = 0);
        token := token + ch;
        idx := idx + 1;
    ENDLOOP;

    RETURN (token);
ENDPROCEDURE;

!
!   A function to see if the string "token" is a lead substring of "cmd".
!
PROCEDURE vi$leading_str (token, cmd)
    RETURN ((token <> "") AND (INDEX (cmd, token) = 1));
ENDPROCEDURE;

!
!   A routine that looks for the first occurance of a character in
!   "seps", in "cmd", and then changes "idx" to reflect that locatation.
!   "separ" will contain the character in "seps" that was actually found.
!
PROCEDURE vi$skip_separ (cmd, idx, seps, separ)
    LOCAL
        nch,
        retstr;

    retstr := "";
    separ := "";
    vi$skip_white (cmd, idx);

    LOOP
        EXITIF (idx > LENGTH (cmd));
        nch := SUBSTR (cmd, idx, 1);
        idx := idx + 1;
        IF (INDEX (seps, nch) <> 0) OR (nch = " ") OR (nch = ASCII (9)) THEN
            separ := nch;
            RETURN (retstr);
        ENDIF;
        retstr := retstr + nch;
    ENDLOOP;
    RETURN (retstr);
ENDPROCEDURE;

!
!   A procedure that returns the characters occuring at index, "idx", and
!   after in the string "cmd".
!
PROCEDURE vi$rest_of_line (cmd, idx)
    RETURN (SUBSTR (cmd, idx, LENGTH (cmd)-idx + 1));
ENDPROCEDURE;

!
!  SET (INFORMATIONAL/SUCCESS) short procedures.
!
PROCEDURE vi$info_success_off vi$info_off; vi$success_off; ENDPROCEDURE;
PROCEDURE vi$info_success_on vi$info_on; vi$success_on; ENDPROCEDURE;
PROCEDURE vi$success_off SET (SUCCESS, OFF); ENDPROCEDURE;
PROCEDURE vi$success_on SET (SUCCESS, ON); ENDPROCEDURE;
PROCEDURE vi$info_off SET (INFORMATIONAL, OFF); ENDPROCEDURE;
PROCEDURE vi$info_on SET (INFORMATIONAL, ON); ENDPROCEDURE;

!
!   Called from vi$do_global to perform a substitution during a global command.
!
PROCEDURE vi$global_subs (cmd, nsubs)

    LOCAL
        idx,
        result_text,
        replace_text,
        hrange,
        ch,
        pos,
        spos,
        epos,
        lpos,
        source,
        scount,
        dest,
        query,
        doglobal,
        replace,
        separ;

    idx := 1;

    separ := vi$next_char (cmd, idx);

    source := "";
    dest   := "";
    doglobal := 0;
    query  := 0;

    LOOP
        IF (idx > LENGTH (cmd)) THEN
            vi$info ("Insufficent arguments!");
            RETURN (0);
        ENDIF;

        ch := SUBSTR (cmd, idx, 1);
        EXITIF ch = separ;
        source := source + ch;
        idx := idx + 1;
    ENDLOOP;

    idx := idx + 1;
    LOOP
        EXITIF idx > LENGTH (cmd);
        ch := SUBSTR (cmd, idx, 1);
        EXITIF ch = separ;
        dest := dest + ch;
        idx := idx + 1;
    ENDLOOP;

    idx := idx + 1;
    LOOP
        EXITIF idx > LENGTH (cmd);
        ch := SUBSTR (cmd, idx, 1);
        IF (ch = "q") or (ch = "c") THEN
            query := 1;
        ELSE
            IF ch = "g" THEN
                doglobal := 1;
            ELSE
                vi$info ("Unrecognized command qualifier '"+ch+"'");
                RETURN (0);
            ENDIF;
        ENDIF;
        idx := idx + 1;
    ENDLOOP;

    vi$replace_source := source;
    vi$replace_dest := dest;

    lpos := vi$perform_subs (source, dest, vi$cur_line_no,
                                                scount, doglobal, query);
    nsubs := nsubs + scount;

    RETURN (lpos);
ENDPROCEDURE;
!
!   Called from vi$do_command to parse the rest of the command line,
!   this procedure then envokes lower level routines to perform the work
!   of a substitution command.
!
PROCEDURE vi$do_substitute (start_line, end_line, whole_range, idx, cmd)

    LOCAL
        result_text,
        replace_text,
        hrange,
        ch,
        pos,
        spos,
        epos,
        lpos,
        source,
        scount,
        dest,
        query,
        doglobal,
        replace,
        separ;

    pos := MARK (NONE);
    POSITION (END_OF (whole_range));
    epos := MARK (NONE);
    POSITION (pos);

    separ := vi$next_char (cmd, idx);
    vi$replace_separ := separ;

    source := "";
    dest   := "";
    doglobal := 0;
    query  := 0;

    LOOP
        IF (idx > LENGTH (cmd)) THEN
            vi$info ("Insufficent arguments!");
            RETURN (1);
        ENDIF;

        ch := SUBSTR (cmd, idx, 1);
        EXITIF ch = separ;
        source := source + ch;
        idx := idx + 1;
    ENDLOOP;

    idx := idx + 1;
    LOOP
        EXITIF idx > LENGTH (cmd);
        ch := SUBSTR (cmd, idx, 1);
        EXITIF ch = separ;
        dest := dest + ch;
        idx := idx + 1;
    ENDLOOP;

    idx := idx + 1;
    LOOP
        EXITIF idx > LENGTH (cmd);
        ch := SUBSTR (cmd, idx, 1);
        IF (ch = "q") OR (ch = "c") THEN
            query := 1;
        ELSE
            IF ch = "g" THEN
                doglobal := 1;
            ELSE
                vi$info ("Unrecognized command qualifier '"+ch+"'");
                RETURN (1);
            ENDIF;
        ENDIF;
        idx := idx + 1;
    ENDLOOP;

    POSITION (pos);
    vi$save_for_undo (whole_range, VI$LINE_MODE, 1);
    vi$move_to_line (start_line);

    IF MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER) THEN
        MOVE_HORIZONTAL (-1);
        spos := MARK (NONE);
        MOVE_HORIZONTAL (1);
    ELSE
        spos := 0;
    ENDIF;

    vi$replace_source := source;
    vi$replace_dest := dest;

    scount := 0;
    lpos := vi$perform_subs (source, dest, end_line, scount, doglobal, query);

    IF (scount = 0) THEN
        vi$kill_undo;
        vi$undo_end := 0;
        POSITION (pos);
    ELSE
        vi$undo_end := epos;
        IF (spos = 0) THEN
            vi$undo_start := BEGINNING_OF (CURRENT_BUFFER);
        ELSE
            POSITION (spos);
            MOVE_HORIZONTAL (1);
            vi$undo_start := MARK (NONE);
        ENDIF;
        vi$pos_in_middle (lpos);
        vi$info (FAO ("!UL substitution!%S!", scount));
    ENDIF;

    RETURN (1);
ENDPROCEDURE;

!
!   Repeat the last substitute command that was issued at the ":" prompt.
!
!   The function mapped to '&'.
!
PROCEDURE vi$repeat_subs
    LOCAL
        scount,
        doglobal,
        query,
        lpos,
        spos,
        pos,
        epos,
        here;

    IF (vi$replace_separ = 0) THEN
        vi$info ("No previous substitution!");
        RETURN;
    ENDIF;

    doglobal := 0;
    query := 0;
    here := vi$cur_line_no;
    vi$save_for_undo (CURRENT_LINE, VI$LINE_MODE, 1);

    pos := MARK (NONE);
    POSITION (LINE_BEGIN);

    spos := vi$get_undo_start;

    POSITION (LINE_END);
    IF (LENGTH (CURRENT_LINE) > 0) THEN
        MOVE_HORIZONTAL (-1);
    ENDIF;
    epos := MARK (NONE);
    POSITION (pos);

    lpos := vi$perform_subs (vi$replace_source, vi$replace_dest,
                                                here, scount, doglobal, query);

    IF (scount = 0) THEN
        vi$kill_undo;
        vi$undo_end := 0;
    ELSE
        vi$undo_end := epos;
        vi$undo_start := vi$set_undo_start (spos);
        POSITION (lpos);
    ENDIF;

    RETURN (lpos);
ENDPROCEDURE;

!
!   Perform a substitution from the current location to "end_line".
!   Use source as the search string, and dest as the substitution
!   spec.  "global" indicates whether or not all occurances on a line
!   are examined, and "query" indicates whether or not to prompt before
!   performing the substitution.  On return, "scount" will hold the
!   number of substitutions actually performed.
!
PROCEDURE vi$perform_subs (source, dest, end_line, scount, doglobal, query)

    LOCAL
        result_text,
        replace_text,
        answer,
        fcnt,
        lpos,
        hrange,
        replace,
        fpos,
        quit_now,
        cwin,
        pos;

    SET (FORWARD, CURRENT_BUFFER);
    scount := 0;
    fcnt := 0;
    quit_now := 0;
    pos := MARK (NONE);

    LOOP
        fpos := vi$find_str (source, 1, 1);
        EXITIF (fpos = 0);
        fcnt := fcnt + 1;
        POSITION (BEGINNING_OF (fpos));

        IF vi$cur_line_no > end_line THEN
            POSITION (pos);
            EXITIF (1);
        ENDIF;
        result_text := SUBSTR (fpos, 1, LENGTH (fpos));
        replace_text := vi$substitution (result_text, dest);
        POSITION (BEGINNING_OF (fpos));

        replace := 1;
        IF (query) THEN
            POSITION (BEGINNING_OF (fpos));
            hrange := CREATE_RANGE (BEGINNING_OF (fpos),
                                                    END_OF (fpos), REVERSE);
            cwin := GET_INFO (WINDOWS, "FIRST");
            LOOP
                EXITIF (cwin = 0);
                IF (GET_INFO (cwin, "VISIBLE")) THEN
                    UPDATE (cwin);
                ENDIF;
                cwin := GET_INFO (WINDOWS, "NEXT");
            ENDLOOP;

            answer := vi$read_line ("Replace y/n/a/q? ");

            CHANGE_CASE (answer, LOWER);
            IF (answer = "") OR (INDEX ("yes", answer) <> 1) THEN
                replace := 0;
            ENDIF;
            IF (INDEX ("quit", answer) = 1) THEN
                quit_now := 1;
            ENDIF;
            IF (INDEX ("all", answer) = 1) THEN
                query := 0;
                replace := 1;
            ENDIF;
        ENDIF;

        IF replace THEN

!           This is a hack necessary to fix TPU's pattern matching.
!           The length of the text matched by only "line_begin" and
!           "line_end" has length == 1 instead of 0 as one would expect.

            IF (source <> "^") AND (source <> "$") AND (source <> "") THEN
                ERASE_CHARACTER (LENGTH (result_text));
            ENDIF;
            COPY_TEXT (replace_text);
            pos := MARK (NONE);
            scount := scount + 1;
        ELSE
            MOVE_HORIZONTAL (1);
        ENDIF;

        IF NOT doglobal THEN
            POSITION (LINE_BEGIN);
            EXITIF MARK (NONE) = END_OF (CURRENT_BUFFER);
            MOVE_VERTICAL (1);
        ENDIF;
        EXITIF quit_now;
    ENDLOOP;

    IF fcnt = 0 THEN
        vi$info ("string not found!");
    ENDIF;

    RETURN (pos);
ENDPROCEDURE;

!
!   Move horizontal, ignoring errors
!
PROCEDURE vi$move_horizontal (cnt)
    ON_ERROR
    ENDON_ERROR;

    MOVE_HORIZONTAL (cnt);
ENDPROCEDURE;

!
!   Move vertical, ignoring errors
!
PROCEDURE vi$move_vertical (cnt)
    ON_ERROR
    ENDON_ERROR;

    MOVE_VERTICAL (cnt);
ENDPROCEDURE;

!
!   Move to the indicated line number.
!
PROCEDURE vi$move_to_line (line_no)
    LOCAL
        pos;

    ON_ERROR
        POSITION (pos);
        RETURN (0);
    ENDON_ERROR;

    pos := MARK (NONE);
    POSITION (BEGINNING_OF (CURRENT_BUFFER));
    MOVE_VERTICAL (line_no - 1);

    RETURN (MARK (NONE));
ENDPROCEDURE;

!
!   Give a source string, and a "dest" substitution spec, perform the
!   RE style substitution, and return the resultant string.
!
PROCEDURE vi$substitution (source, dest)

    LOCAL
        cur_char,
        result,
        idx;

    idx := 0;
    result := "";

    LOOP
        EXITIF (idx > LENGTH(dest));

        cur_char := SUBSTR (dest, idx, 1);
        IF (cur_char = "&") THEN
            result := result + source;
            idx := idx + 1;
        ELSE
            IF (cur_char = '\') THEN
                cur_char := SUBSTR(dest, idx+1, 1);
                IF (INDEX ("123456789", cur_char) > 0) THEN
                    vi$global_var := 0;
                    IF INT(cur_char) > 1 THEN
                        EXECUTE (COMPILE ("vi$global_var := SUBSTR (p" +
                            cur_char +", LENGTH (o"+cur_char+")+1,512);"));
                    ELSE
                        EXECUTE (COMPILE ("vi$global_var := SUBSTR (p" +
                            cur_char +", LENGTH (o"+cur_char+"),512);"));
                    ENDIF;
                    result := result + vi$global_var;
                ELSE
                    IF (cur_char = "&") THEN
                        result := result + cur_char;
                    ELSE
                        result := result + "\" + cur_char;
                    ENDIF;
                ENDIF;
                idx := idx + 2;
            ELSE
                result := result + cur_char;
                idx := idx + 1;
            ENDIF;
        ENDIF;
    ENDLOOP;

    RETURN (result);
ENDPROCEDURE;

!
!   Get the next character from a string at idx, and point past the character
!
PROCEDURE vi$next_char (cmd, idx)

    IF idx <= LENGTH (cmd) THEN
        idx := idx + 1;
        RETURN (SUBSTR (cmd, idx -1, 1));
    ENDIF;

    RETURN ("");
ENDPROCEDURE;

!
!  Process all set commands in the string cmd
!
PROCEDURE vi$set_commands (cmd, i)
    LOCAL
        err,
        separ,
        token_1;

    ON_ERROR
        RETURN;
    ENDON_ERROR;

    LOOP
        token_1 := vi$skip_separ (cmd, i, "= "+ASCII(9), separ);
        EDIT (token_1, COLLAPSE);

        EXITIF token_1 = "";

        err :=  vi$set_one (token_1, separ, cmd, i);
        EXITIF err;
    ENDLOOP;
    RETURN (err);
ENDPROCEDURE

!
!  Process a single set command and return success or failure.
!
PROCEDURE vi$set_one (token_1, separ, cmd, i)

    LOCAL
        val,
        errno,
        curwin,
        curbuf,
        buf,
        use_fortran,
        oldscrlen,
        npat,
        pstr,
        token_2;

    ON_ERROR
        errno := ERROR;
        vi$info ("ERROR at line: "+STR(ERROR_LINE)+", "+
                                call_user(vi$cu_getmsg,STR(errno)));
        RETURN (1);
    ENDON_ERROR;

    token_2 := "";
a    IF (token_1 = "all") THEN
        vi$show_settings;
        RETURN (0);
    ENDIF;

    IF (token_1 = "tags") THEN
        vi$tag_files := vi$rest_of_line (cmd, i);
        i := LENGTH (cmd) + 1;
        RETURN (vi$load_tags);
    ENDIF;

    IF (token_1 = "notagcase") OR (token_1 = "notc") THEN
        vi$tag_case := NO_EXACT;
        RETURN (0);
    ENDIF;

    IF (token_1 = "tagcase") OR (token_1 = "tc") THEN
        vi$tag_case := EXACT;
        RETURN (0);
    ENDIF;

    IF (token_1 = "senddcl") THEN
        vi$send_dcl := 1;
        RETURN (0);
    ENDIF;

    IF (token_1 = "nosenddcl") THEN
        vi$send_dcl := 0;
        RETURN (0);
    ENDIF;

    IF (token_1 = "empty") THEN
        vi$delete_empty := 0;
        RETURN (0);
    ENDIF;

    IF (token_1 = "noempty") THEN
        vi$delete_empty := 1;
        RETURN (0);
    ENDIF;

    IF (token_1 = "files") OR (token_1 = "file") THEN
        val := vi$expand_file_list (vi$rest_of_line (cmd, i));
        vi$info (FAO ("!UL file!%S selected", val, 0));
        RETURN (2);
    ENDIF;

    IF (token_1 = "notabs") THEN
        vi$use_tabs := 0;
        RETURN (0);
    ENDIF;

    IF (token_1 = "tabs") THEN
        vi$use_tabs := 1;
        RETURN (0);
    ENDIF;

    IF (token_1 = "noreadonly") OR (token_1 = "noro") THEN
        SET (NO_WRITE, CURRENT_BUFFER, OFF);
        vi$setbufmode (CURRENT_BUFFER, 0);
        vi$status_lines (CURRENT_BUFFER);
        RETURN (0);
    ENDIF;

    IF (token_1 = "readonly") OR (token_1 = "ro") THEN
        vi$setbufmode (CURRENT_BUFFER, 1);
        vi$status_lines (CURRENT_BUFFER);
        RETURN (0);
    ENDIF;

    IF (token_1 = "write") OR (token_1 = "wr") THEN
        SET (NO_WRITE, CURRENT_BUFFER, OFF);
        vi$status_lines (CURRENT_BUFFER);
        RETURN (0);
    ENDIF;

    IF (token_1 = "nowrite") OR (token_1 = "nowr") THEN
        SET (NO_WRITE, CURRENT_BUFFER, ON);
        vi$status_lines (CURRENT_BUFFER);
        RETURN (0);
    ENDIF;

    IF (token_1 = "width") THEN
        token_2 := vi$skip_separ (cmd, i, "= "+ASCII(9), separ);
        val := INT (token_2);
        SET (WIDTH, CURRENT_WINDOW, val);
        vi$scr_width := val;
        RETURN (0);
    ENDIF;

    IF (token_1 = "window") THEN
        token_2 := vi$skip_separ (cmd, i, "= "+ASCII(9), separ);
        val := INT (token_2);
        RETURN (vi$do_set_window (val));
    ENDIF;

    IF (token_1 = "ts") OR (token_1 = "tabstops") THEN
        token_2 := vi$skip_separ (cmd, i, "=  "+ASCII(9), separ);
        val := INT (token_2);
        SET (TAB_STOPS, CURRENT_BUFFER, val);
        vi$tab_amount := val;
        RETURN (0);
    ENDIF;

    IF (token_1 = "sw") OR (token_1 = "shiftwidth") then
        token_2 := vi$skip_separ (cmd, i, "= "+ASCII(9), separ);
        vi$shift_width := INT (token_2);
        RETURN (0);
    ENDIF;

    IF (token_1 = "noautoindent") OR (token_1 = "noai") THEN
        vi$auto_indent := 0;
        RETURN (0);
    ENDIF;

    IF (token_1 = "autoindent") OR (token_1 = "ai") THEN
        vi$auto_indent := 1;
        RETURN (0);
    ENDIF;

    IF (token_1 = "noundomap") OR (token_1 = "noum") THEN
        vi$undo_map := 0;
        RETURN (0);
    ENDIF;

    IF (token_1 = "undomap") OR (token_1 = "um") THEN
        vi$undo_map := 1;
        RETURN (0);
    ENDIF;

    IF (token_1 = "scroll") THEN
        token_2 := vi$skip_separ (cmd, i, "= "+ASCII(9), separ);
        vi$how_much_scroll := INT (token_2);
        RETURN (0);
    ENDIF;

    IF (token_1 = "report") THEN
        token_2 := vi$skip_separ (cmd, i, "= "+ASCII(9), separ);
        vi$report := INT (token_2);
        RETURN (0);
    ENDIF;

    IF (token_1 = "aw") OR (token_1 = "autowrite") THEN
        vi$auto_write := 1;
        RETURN (0);
    ENDIF;

    IF (token_1 = "noaw") OR (token_1 = "noautowrite") THEN
        vi$auto_write := 0;
        RETURN (0);
    ENDIF;

    IF (token_1 = "noic") OR (token_1 = "noignorecase") THEN
        vi$ignore_case := EXACT;
        RETURN (0);
    ENDIF;

    IF (token_1 = "ic") OR (token_1 = "ignorecase") THEN
        vi$ignore_case := NO_EXACT;
        RETURN (0);
    ENDIF;

    IF (token_1 = "magic") THEN
        vi$magic := 1;
        RETURN (0);
    ENDIF;
$$EOD$$