v04i101: TPUVI for VMS part 10 of 17

Gregg Wonderly gregg at a.cs.okstate.edu
Tue Sep 27 11:55:35 AEST 1988


Posting-number: Volume 4, Issue 101
Submitted-by: "Gregg Wonderly" <gregg at a.cs.okstate.edu>
Archive-name: vms-vi-2/Part10

$ WRITE SYS$OUTPUT "Creating ""VI.6"""
$ CREATE VI.6
$ DECK/DOLLARS=$$EOD$$
        ELSE
            IF (vi$wrap_scan = 1) THEN
                POSITION (BEGINNING_OF (CURRENT_BUFFER));
            ENDIF;
        ENDIF;
    ELSE
        prompt := "?" + vi$search_string;
        SET (REVERSE, CURRENT_BUFFER);
        IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
            IF (SUBSTR (prompt, 1, 3) = "?\<") THEN
                MOVE_HORIZONTAL (-2);
            ELSE
                MOVE_HORIZONTAL (-1);
            ENDIF;
        ELSE
            IF (vi$wrap_scan = 1) THEN
                POSITION (END_OF (CURRENT_BUFFER));
            ENDIF;
        ENDIF;
    ENDIF;

    MESSAGE (prompt);

    ! On success then return the position we moved to.

    cnt := vi$cur_active_count;
    LOOP
        where := vi$find_str (vi$search_string, 0, 0);
        EXITIF (where = 0);
        POSITION (BEGINNING_OF (where));
        IF (CURRENT_DIRECTION = FORWARD) THEN
            MOVE_HORIZONTAL (1);
        ELSE
            MOVE_HORIZONTAL (-1);
        ENDIF;
        cnt := cnt - 1;
        EXITIF cnt = 0;
    ENDLOOP;

    IF (where = 0) THEN
        vi$info ("String not found");
    ELSE
        POSITION (BEGINNING_OF (where));
        bpos := MARK (NONE);
        POSITION (END_OF (where));
        vi$find_rng := CREATE_RANGE (bpos, MARK(NONE), BOLD);
        MESSAGE ("");
    ENDIF;

    POSITION (pos);
    RETURN (where);
ENDPROCEDURE;

!
!   This procedure can be used to find a string of text (using RE's).
!   The current direction of the BUFFER is used to determine which way
!   the search goes.  'replace' is used by the replace code to indicate
!   that wrap scan should be performed.
!
PROCEDURE vi$find_str (sstr, replace, do_parens)
    LOCAL
        pos,
        new_pat,
        start,
        where;

    ON_ERROR
    ENDON_ERROR;

    pos := MARK (NONE);
    vi$paren_cnt := 0;
    IF vi$magic THEN
        new_pat := vi$re_pattern_gen (sstr, vi$paren_cnt, do_parens);
    ELSE
        new_pat := vi$pattern_gen (sstr);
    ENDIF;

    IF (new_pat <> 0) THEN
        EXECUTE (COMPILE ("vi$_find_pat := " + new_pat));
        where := SEARCH (vi$_find_pat, CURRENT_DIRECTION, vi$ignore_case);
        IF (where = 0) AND (vi$wrap_scan = 1) AND (replace = 0) THEN
            IF (CURRENT_DIRECTION = FORWARD) THEN
                POSITION (BEGINNING_OF (CURRENT_BUFFER));
            ELSE
                POSITION (END_OF (CURRENT_BUFFER));
            ENDIF;
            where := SEARCH (vi$_find_pat, CURRENT_DIRECTION, vi$ignore_case);
        ENDIF;
    ELSE
        where := 0;
    ENDIF;

    IF (where <> 0) AND (vi$in_ws) THEN
        POSITION (BEGINNING_OF (where));
        IF (CURRENT_OFFSET <> 0) OR
                                (INDEX (vi$_ws, CURRENT_CHARACTER) <> 0) THEN
            MOVE_HORIZONTAL (1);
        ENDIF;
        start := MARK (NONE);
        POSITION (END_OF (where));
        IF (CURRENT_OFFSET <> LENGTH (CURRENT_LINE)) THEN
            MOVE_HORIZONTAL (-1);
        ENDIF;
        where := CREATE_RANGE (start, MARK (NONE), NONE);
        POSITION (pos);
    ENDIF;
    RETURN (where);
ENDPROCEDURE;

!
!   Generate a TPU pattern string, not using RE's, i.e. :set nomagic is
!   in effect when this routine is used.
!
PROCEDURE vi$pattern_gen (pat)

    LOCAL
        first,      ! First pattern to be done
        part_pat,
        chno,
        startchar,
        haveany,
        regular,
        tstr,
        endchar,
        str_pat,
        cur_pat,    ! The current pattern to be extracted
        cur_char,   ! The current character in the regular
                    ! expression being examined
        new_pat,    ! The output pattern
        pos;        ! The position within the regular
                    ! expression string that we are examining
                    ! currently

    IF (INDEX (pat, "$") <> 0) OR (INDEX (pat, "^") <> 0) THEN
        new_pat := "";
    ELSE
        new_pat := '"'+pat+'"';
        RETURN (new_pat);
    ENDIF;

    pos := 1;

    IF SUBSTR (pat, pos, 1) = "^" THEN
        IF LENGTH (pat) > 1 THEN
            new_pat := "line_begin & '";
        ELSE
            new_pat := "line_begin";
        ENDIF;
        pos := pos + 1;
    ENDIF;

    LOOP
        EXITIF (pos > LENGTH (pat));

        regular := 0;
        cur_pat := "";
        cur_char := substr (pat, pos, 1);

        IF (cur_char = "$") AND (pos+1 >= LENGTH (pat)) THEN
            IF pos <> 1 THEN
                cur_pat := "' & line_end";
            ELSE
                cur_pat := "line_end";
            ENDIF;
        ELSE
            cur_pat := cur_char;
            regular := 1;
        ENDIF;

        IF (regular) THEN
            new_pat := new_pat + cur_pat;
        ELSE
            IF new_pat = "" THEN
                new_pat := cur_pat;
            ELSE
                new_pat := new_pat + "&" + cur_pat;
            ENDIF;
        ENDIF;

        pos := pos + 1;

    ENDLOOP;

    IF (regular) THEN
        new_pat := new_pat + "'";
    ENDIF;
    RETURN (new_pat);
ENDPROCEDURE;
!
!
! TPU pattern generator.  Generates a pattern string from the passed
! RE string.  The function is used when :set magic is in effect.
!
PROCEDURE vi$re_pattern_gen (pat, paren_cnt, do_parens)

    LOCAL
        first,      ! First pattern to be done
        part_pat,
        chno,
        startchar,
        haveany,
        regular,
        tstr,
        endchar,
        pat_str,
        str_pat,
        cur_pat,    ! The current pattern to be extracted
        cur_char,   ! The current character in the regular
                    ! expression being examined
        new_pat,    ! The output pattern
        in_ws,
        pos;        ! The position within the regular
                    ! expression string that we are examining
                    ! currently

    vi$in_ws := 0;
    IF ((INDEX (pat, "$") <> 0) OR (INDEX (pat, "[") <> 0) OR
                    (INDEX (pat, "^") <> 0) OR (INDEX (pat, ".") <> 0) OR
                        (INDEX (pat, "*") <> 0) OR (INDEX (pat, "\") <> 0) OR
                        (INDEX (pat, '"') <> 0)) THEN
        new_pat := "";
    ELSE
        new_pat := '"'+pat+'"';
        RETURN (new_pat);
    ENDIF;

    in_ws := 0;
    pos := 1;

    IF SUBSTR (pat, pos, 1) = "^" THEN
        new_pat := "line_begin";
        pos := pos + 1;
    ENDIF;

    LOOP
        EXITIF (pos > LENGTH (pat));

        regular := 0;
        cur_pat := "";
        cur_char := substr (pat, pos, 1);
        pat_str := "";

        IF (cur_char = "^") THEN
            vi$info ("^ found in the middle of a line, use \ to escape it!");
            RETURN (0);
        ENDIF;

        IF (cur_char = "$") THEN
            IF (pos >= LENGTH (pat)) THEN
                cur_pat := "line_end";
            ELSE
                vi$info ("$ found before end of string");
                RETURN (0);
            ENDIF;
        ELSE
            IF cur_char = "[" THEN
                pos := pos + 1;

                IF SUBSTR (pat, pos, 1) = "^" THEN
                    pos := pos + 1;
                    part_pat := "notany('";
                ELSE
                    part_pat := "any('";
                ENDIF;

                LOOP
                    EXITIF pos > LENGTH (pat);
                    EXITIF SUBSTR (pat, pos, 1) = "]";

                    IF SUBSTR (pat, pos, 1) = "\" THEN
                        pos := pos + 1;
                        IF pos > LENGTH (pat) THEN
                            vi$info ("Missing character after \");
                            RETURN (0);
                        ENDIF;
                    ENDIF;

                    startchar := SUBSTR (pat, pos, 1);
                    pat_str := pat_str + startchar;
                    IF startchar = "'" THEN
                        pat_str := pat_str + "'";
                    ENDIF;

                    IF (SUBSTR (pat, pos+1, 1) = '-') THEN
                        pos := pos + 2;
                        IF (pos >= LENGTH (pat)) THEN
                            vi$info ("Missing character after '-'");
                            RETURN (0);
                        ENDIF;

                        endchar := SUBSTR (pat, pos, 1);

                        chno := 1;
                        LOOP
                            EXITIF (ASCII(chno) = startchar);
                            chno := chno + 1;
                        ENDLOOP;

                        LOOP
                            chno := chno + 1;
                            IF (chno > 255) THEN
                                vi$info (
                                    "Invalid character sequence for '-'");
                                RETURN (0);
                            ENDIF;

                            EXITIF (ASCII (chno-1) = endchar);
                            pat_str := pat_str + ASCII (chno);
                            IF ASCII (chno) = "'" THEN
                                pat_str := pat_str + "'";
                            ENDIF;
                        ENDLOOP;
                    ENDIF;
                    pos := pos + 1;
                ENDLOOP;

                IF pat_str = "" THEN
                    vi$info ("No text found between []");
                    RETURN (0);
                ENDIF;

                IF (SUBSTR (pat, pos+1, 1) = "*") THEN
                    IF (part_pat = "notany('") THEN
                        cur_pat := cur_pat + "(scan('"+pat_str+"')|"""")";
                    ELSE
                        cur_pat := cur_pat + "(span('"+pat_str+"')|"""")";
                    ENDIF;
                    pos := pos + 1;
                ELSE
                    cur_pat := part_pat + pat_str + "')";
                ENDIF;
            ELSE

                tstr := '"';
                haveany := 0;
                regular := 1;

                LOOP
                    cur_char := SUBSTR (pat, pos, 1);
                    EXITIF (cur_char = "^") OR (cur_char = "[") OR
                            (cur_char = "$");
                    EXITIF (pos > LENGTH (pat));

                    IF cur_char = "\" THEN
                        pos := pos + 1;
                        startchar := SUBSTR (pat, pos, 1);
                        IF (do_parens) THEN
                            IF (startchar = "(") THEN
                                paren_cnt := paren_cnt + 1;

                                IF tstr = '"' THEN
                                    tstr := '""@o'+STR(paren_cnt)+'&"';
                                ELSE
                                    tstr := tstr + '"@o'+STR(paren_cnt)+'&"';
                                ENDIF;
                            ELSE
                                IF (startchar = ")") THEN
                                    IF (paren_cnt = 0) THEN
                                        vi$info (
                                            FAO ("No previous ""\("" near: !AS",
                                            SUBSTR (pat, pos, LENGTH(pat)-pos))
                                        );
                                        RETURN (0);
                                    ENDIF;

                                    IF tstr = '"' THEN
                                        tstr := '""@p'+STR(paren_cnt)+'&"';
                                    ELSE
                                        tstr := tstr + '"@p' +
                                                    STR(paren_cnt)+'&"';
                                    ENDIF;
                                ELSE
                                    IF (startchar = "<") THEN
                                        in_ws := 1;
                                        vi$in_ws := 1;
                                        tstr := tstr +
                                            '"&(line_begin | any (vi$_ws))&"';
                                    ELSE
                                        IF (startchar = ">") THEN
                                            in_ws := 0;
                                            tstr := tstr +
                                                '"&(line_end | any (vi$_ws))&"';
                                        ELSE
                                            tstr := tstr + SUBSTR (pat, pos, 1);
                                        ENDIF;
                                    ENDIF;
                                ENDIF;
                            ENDIF;
                        ELSE
                            IF (startchar = "<") THEN
                                in_ws := 1;
                                vi$in_ws := 1;
                                tstr := tstr +
                                    '"&(line_begin | any (vi$_ws))&"';
                            ELSE
                                IF (startchar = ">") THEN
                                    in_ws := 0;
                                    tstr := tstr
                                        + '"&(line_end | any (vi$_ws))&"';
                                ELSE
                                    tstr := tstr + startchar;
                                ENDIF;
                            ENDIF;
                        ENDIF;
                    ELSE
                        IF (cur_char = ".") THEN
                            cur_char := "longer_than_1";
                        ENDIF;

                        IF (SUBSTR (pat, pos+1, 1) = '*') THEN
                            pos := pos + 1;

                            IF (LENGTH (cur_char) > 1) THEN
                                cur_pat := "span(vi$pch)";
                            ELSE
                                cur_pat := "span('"+cur_char+"')";
                            ENDIF;
                            tstr := tstr+'"&'+cur_pat+'&"';
                            haveany := 0;
                        ELSE
                            IF (LENGTH (cur_char) > 1) THEN
                                IF (haveany) THEN
                                    tstr := tstr +'"&'+"arb(1)"+'&"';
                                    haveany := 0;
                                ELSE
                                    IF (LENGTH (tstr)>0) and (tstr <> '"') THEN
                                        tstr := tstr +'"&'+"arb(1)"+'&"';
                                    ELSE
                                        tstr := "arb(1)"+'&"';
                                    ENDIF
                                ENDIF;
                            ELSE
                                IF (cur_char = """") THEN
                                    tstr := tstr + '""';
                                    haveany := haveany + 2;
                                ELSE
                                    tstr := tstr + cur_char;
                                    haveany := haveany + 1;
                                ENDIF;
                            ENDIF;
                        ENDIF;
                    ENDIF;
                    pos := pos + 1;
                ENDLOOP;
                cur_pat := tstr + '"';
                pos := pos - 1;
            ENDIF;
        ENDIF;

        IF (regular) THEN
            IF new_pat = "" THEN
                new_pat := cur_pat;
            ELSE
                IF (LENGTH (tstr) > 1) THEN
                    new_pat := new_pat + "&" + cur_pat;
                ENDIF;
            ENDIF;
        ELSE
            IF new_pat = "" THEN
                new_pat := cur_pat;
            ELSE
                new_pat := new_pat + "&" + cur_pat;
            ENDIF;
        ENDIF;
        pos := pos + 1;

    ENDLOOP;

    IF (in_ws) THEN
        vi$info ("Missing \> in pattern!");
        RETURN (0);
    ENDIF;

    RETURN (new_pat);
ENDPROCEDURE;

!
!   Match brackets when '%' is typed.
!
PROCEDURE vi$_match_brackets
    vi$beep_position (vi$match_brackets, 1, 1);
ENDPROCEDURE;

!
!   Perform the actual match bracket operation.
!
PROCEDURE vi$match_brackets
    LOCAL
        newpos,
        ind_pos,
        found,
        cur_ch,
        cur_dir,
        pos;

    ON_ERROR
        IF ERROR = TPU$_CONTROLC THEN
            vi$beep;
            vi$pasthru_on;
            RETURN (0);
        ENDIF;
    ENDON_ERROR;

    found := 1;
    MESSAGE ("");
    pos := MARK (NONE);
    cur_ch := CURRENT_CHARACTER;
    ind_pos := INDEX (vi$bracket_chars, cur_ch);

    IF (ind_pos = 0) THEN
        newpos := SEARCH (ANCHOR & SCAN (")") & ARB (1), FORWARD, EXACT);
        found := 0;
        IF newpos <> 0 THEN
            found := 1;
            IF vi$in_show_match = 0 THEN
                vi$old_place := pos;
            ENDIF;
            POSITION (END_OF (newpos));
            RETURN (vi$retpos (pos));
        ELSE
            POSITION (pos);
            RETURN (0);
        ENDIF;
    ENDIF;

    IF ((ind_pos/2)*2 <> ind_pos) THEN
        cur_dir := FORWARD;
    ELSE
        cur_dir := REVERSE;
    ENDIF;

    SET (TIMER, ON, "Searching...");
    newpos := vi$do_match (CURRENT_CHARACTER, cur_dir, 0);
    SET (TIMER, OFF);

    IF (GET_INFO (newpos, "TYPE") = MARKER) THEN
        RETURN (vi$retpos (pos));
    ELSE
        IF (newpos = 0) AND NOT (vi$in_show_match) THEN
            vi$info ("No matching bracket");
        ENDIF;
        POSITION (pos);
    ENDIF;
    RETURN (0);
ENDPROCEDURE;
!
!
!  This procedure knows how to traverse nested brackets to find the matching
!  bracket.  It takes the character that the cursor is positioned on, and
!  finds the matching one.  It recognizes '{}', '[]', '()' pairs.
!
PROCEDURE vi$do_match (bracket, cur_dir, level)

    LOCAL
        dgrp,
        dest_char,
        sel_reg,
        ind_pos,
        next_pos,
        possibles,
        cur_ch;

    ON_ERROR
        RETURN (0);
    ENDON_ERROR;

    IF level > 30 THEN
        vi$info ("Too many nested levels");
        RETURN (-1);
    ENDIF;

    ! Identify the desired search direction based on the character.

    ind_pos := INDEX (vi$bracket_chars, bracket);
    dest_char := SUBSTR ("}{)(][", ind_pos, 1);

    IF cur_dir = FORWARD THEN
        MOVE_HORIZONTAL (1);
    ENDIF;

    dgrp := bracket + dest_char;
    LOOP
        sel_reg := SEARCH (ANY (dgrp), cur_dir, EXACT);

        IF sel_reg = 0 THEN
            RETURN (0);
        ENDIF;

        POSITION (BEGINNING_OF (sel_reg));

        IF (CURRENT_CHARACTER = dest_char) THEN
            RETURN (MARK (NONE));
        ELSE
            IF (((INDEX ("([{", CURRENT_CHARACTER) <> 0) AND
                            (cur_dir = FORWARD)) OR
                    ((INDEX (")}]", CURRENT_CHARACTER) <> 0) AND
                            (cur_dir = REVERSE))) THEN

                IF (INDEX (vi$bracket_chars, CURRENT_CHARACTER)-1)/2 <=
                            (INDEX (vi$bracket_chars, dest_char)-1)/2 THEN

                    next_pos := vi$do_match (CURRENT_CHARACTER,
                                                            cur_dir, level+1);

                    IF (next_pos <> 0) AND (next_pos <> -1) THEN
                        POSITION (next_pos);
                    ELSE
                        RETURN (next_pos);
                    ENDIF;
                ENDIF;
            ELSE
                IF (INDEX (vi$bracket_chars, CURRENT_CHARACTER) = 0) THEN
                    vi$info ("Unknown bracket character: '"+
                                                    CURRENT_CHARACTER+"'");
                    RETURN (-1);
                ENDIF;
            ENDIF;

            IF cur_dir = FORWARD THEN
                MOVE_HORIZONTAL (1);
            ENDIF;
        ENDIF;
    ENDLOOP;
ENDPROCEDURE;

!
!   Move to the top line of the window when 'H' is pressed.
!
PROCEDURE vi$home
    POSITION (vi$to_home);
ENDPROCEDURE;

!
!   Perform the actual movement for the 'H' command and return the marker.
!
PROCEDURE vi$to_home

    LOCAL
        pos;

    ON_ERROR
        ! Ignore attempt to move beyond end of buffer errors.
    ENDON_ERROR;

    pos := MARK (NONE);
    MOVE_VERTICAL ( GET_INFO (CURRENT_WINDOW, "VISIBLE_TOP") -
                    GET_INFO (CURRENT_WINDOW, "CURRENT_ROW"));

    vi$yank_mode := VI$LINE_MODE;
    RETURN (vi$retpos(pos));
ENDPROCEDURE

!
!   Position the cursor into the middle of the current window when 'M' is
!   pressed.
!
PROCEDURE vi$middle
    POSITION (vi$to_middle);
ENDPROCEDURE;

!
!   Perform the actual movement of the 'M' command.
!
PROCEDURE vi$to_middle

    LOCAL
        len,
        cur,
        top,
        pos;

    ON_ERROR
        ! Ignore attempt to move beyond end of buffer errors.
    ENDON_ERROR;

    pos := MARK (NONE);

    len := GET_INFO (CURRENT_WINDOW, "VISIBLE_LENGTH");
    cur := GET_INFO (CURRENT_WINDOW, "CURRENT_ROW");
    top := GET_INFO (CURRENT_WINDOW, "VISIBLE_TOP");

    MOVE_VERTICAL ((top + len/2 - 1) - cur);

    vi$yank_mode := VI$LINE_MODE;
    RETURN (vi$retpos(pos));
ENDPROCEDURE;

!
!   Move the the last line of the current window when 'L' is pressed.
!
PROCEDURE vi$last
    POSITION (vi$to_last);
ENDPROCEDURE;

!
!   Perform the actual movement associated with the 'L' command.
!
PROCEDURE vi$to_last

    LOCAL
        pos;

    ON_ERROR
        ! Ignore attempt to move beyond end of buffer errors.
    ENDON_ERROR;

    pos := MARK (NONE);
    MOVE_VERTICAL ( GET_INFO (CURRENT_WINDOW, "VISIBLE_BOTTOM") -
                    GET_INFO (CURRENT_WINDOW, "CURRENT_ROW"));

    vi$yank_mode := VI$LINE_MODE;
    RETURN (vi$retpos (pos));
ENDPROCEDURE

!
!   Move to the end of the current line when '$' is pressed.
!
PROCEDURE vi$_eol
    POSITION (vi$eol);
ENDPROCEDURE;

!
!   Perform the actual movement associated with the '$' command.
!
PROCEDURE vi$eol
    LOCAL
        cnt,
        pos;

    ON_ERROR
        POSITION (pos);
        vi$active_count := 0;
        RETURN (0);
    ENDON_ERROR;

    pos := MARK (NONE);
    POSITION (LINE_BEGIN);
    cnt := vi$active_count;
    IF cnt = 0 THEN
        cnt := 1;
    ENDIF;
    MOVE_VERTICAL (cnt - 1);
    IF (CURRENT_CHARACTER = "") THEN
        RETURN (0);
    ENDIF;

    POSITION (LINE_END);
    vi$check_rmarg;

    IF (vi$active_count > 0) THEN
        vi$yank_mode := VI$LINE_MODE;
    ELSE
        vi$yank_mode := VI$IN_LINE_MODE;
    ENDIF;
    vi$active_count := 0;
    RETURN (vi$retpos (pos));
ENDPROCEDURE;

!
!   Move the first non-blank character of the line when '^' is typed.
!
PROCEDURE vi$_bol (use_cur_active)
    vi$beep_position (vi$first_no_space (use_cur_active), 0, 1);
ENDPROCEDURE;

!
!   Move the beginning of the line when '0' is typed.
!
PROCEDURE vi$fol
    LOCAL
        pos;

    pos := MARK (NONE);
    POSITION (LINE_BEGIN);
    vi$yank_mode := VI$IN_LINE_MODE;
    vi$new_offset := 1;
    RETURN (vi$retpos (pos));
ENDPROCEDURE;

!
!   Move the the location searched for.
!
PROCEDURE vi$_search (direction)
    LOCAL
        opos,
        pos;

    opos := MARK (NONE);
    pos := vi$search(direction);

    IF (vi$beep_position (pos, 1, 0) <> 0) THEN
        POSITION (opos);
        vi$pos_in_middle (pos);
    ENDIF;
ENDPROCEDURE;

!
!   Move to the next location of the string previously searched for.
!
PROCEDURE vi$_search_next (direction)
    LOCAL
        opos,
        pos;

    opos := MARK(NONE);
    pos := vi$search_next(direction);

    IF (vi$beep_position (pos, 1, 0) <> 0) THEN
        POSITION (opos);
        vi$pos_in_middle (pos);
    ENDIF;
ENDPROCEDURE;

!
!   Repeat the last 't' or 'f' command backwards.
!
PROCEDURE vi$_repeat_torf_back
    vi$beep_position (vi$repeat_torf_back, 0, 1);
ENDPROCEDURE

!
!   Repeat the last 't' or 'f' command.
!
PROCEDURE vi$_repeat_torf
    vi$beep_position (vi$repeat_torf, 0, 1);
ENDPROCEDURE

!
!   Return the location found by repeating the last 't', 'f', 'T' or 'F'
!   command backwards.
!
PROCEDURE vi$repeat_torf_back
    LOCAL
        ch,
        old_func,
        back_func;

    IF vi$last_s_func = 0 THEN
        RETURN (0);
    ENDIF;

    old_func := vi$last_s_func;
    IF (vi$last_s_func = "vi$back_find_char") THEN
        back_func := "vi$find_char";
    ENDIF;

    IF (vi$last_s_func = "vi$find_char") THEN
        back_func := "vi$back_find_char";
    ENDIF;

    IF (vi$last_s_func = "vi$back_to_char") THEN
        back_func := "vi$to_char";
    ENDIF;

    IF (vi$last_s_func = "vi$to_char") THEN
        back_func := "vi$back_to_char";
    ENDIF;

    vi$global_var := 0;
    ch := vi$last_s_char;
    IF (ch = "'") THEN
        ch := "''";
    ENDIF;

    EXECUTE (COMPILE (
        "vi$global_var := " + back_func + "('"+ ch + "')"));
    vi$last_s_func := old_func;
    RETURN (vi$global_var);
ENDPROCEDURE

!
!   Return the location found by repeating the last 't', 'f', 'T' or 'F'
!   command.
!
PROCEDURE vi$repeat_torf

    LOCAL
        ch;

    vi$global_var := 0;
    ch := vi$last_s_char;
    IF (ch = "'") THEN
        ch := "''";
    ENDIF;
    IF (vi$last_s_func <> 0) THEN
        EXECUTE (COMPILE (
            "vi$global_var := " + vi$last_s_func + "('"+ ch + "')"));
    ELSE
        vi$beep;
    ENDIF;
    RETURN (vi$global_var);
ENDPROCEDURE

!
!   Return the value of a positive integer that is represented as a string.
!   If the string is not a valid integer, then -1 is retured.
!
PROCEDURE vi$number_from_string (str_num)
    ON_ERROR
        RETURN (-1);
    ENDON_ERROR;

    RETURN (INT (str_num));
ENDPROCEDURE;

!
!   Move to the line indicated by 'line_no', and return the marker that
!   indicates the beginning of that line.
!
PROCEDURE vi$mark_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 (vi$retpos (pos));
ENDPROCEDURE;

!
!   Perform an EX mode command after a ':' is typed.
!
PROCEDURE vi$ex_mode
    LOCAL
        cmd_str;

    IF (vi$read_a_line (":", cmd_str) <> 0) and (cmd_str <> "") THEN
        vi$do_cmd_line (cmd_str);
    ENDIF;
ENDPROCEDURE;

!
!
!
PROCEDURE vi$read_a_line (prompt, cmd_str)
    LOCAL
        cmd_idx,
        addch,
        ch,
        did_ctl_v,
        win,
        pos;

    win := CURRENT_WINDOW;
    pos := MARK (NONE);

    POSITION (END_OF (command_buffer));
    MAP (command_window, command_buffer);
    COPY_TEXT (prompt);
    SET (OVERSTRIKE, CURRENT_BUFFER);

    cmd_str := "";
    cmd_idx := 0;
    LOOP
        vi$update (CURRENT_WINDOW);
        ch := vi$read_a_key;

        did_ctl_v := 0;
        IF ch = CTRL_V_KEY THEN
            COPY_TEXT ("^");
            did_ctl_v := 1;
            MOVE_HORIZONTAL (-1);
            vi$update (CURRENT_WINDOW);
            ch := vi$read_a_key;
            ERASE_CHARACTER (1);
        ENDIF;

        EXITIF ((ch = RET_KEY) OR (ch = F11)) AND (did_ctl_v = 0);

        IF (ch = RET_KEY) THEN ch := CTRL_M_KEY; ENDIF;
        IF (ch = F12) THEN ch := CTRL_H_KEY; ENDIF;
        IF (ch = F11) THEN ch := KEY_NAME (ASCII (27)); ENDIF;

        IF ((ch = DEL_KEY) OR (ch = CTRL_H_KEY)) AND (did_ctl_v = 0) THEN
            IF cmd_idx = 0 THEN
                UNMAP (command_window);
                UNMAP (message_window);
                MAP (message_window, message_buffer);
                POSITION (win);
                POSITION (pos);
                RETURN (0);
            ENDIF;
            ch := SUBSTR (cmd_str, cmd_idx, 1);
            cmd_idx := cmd_idx - 1;
            IF (INDEX (vi$_ctl_chars, ch) <> 0) THEN
                MOVE_HORIZONTAL (-2);
            ELSE
                MOVE_HORIZONTAL (-1);
            ENDIF;
            cmd_str := SUBSTR (cmd_str, 1, cmd_idx);
        ELSE
            IF (INT(ch) <= INT(KEY_NAME (ASCII (31)))) AND
                                (INT (ch) >= INT(CTRL_A_KEY)) THEN
                IF ch = TAB_KEY THEN
                    addch := 9;
                    COPY_TEXT (ASCII(addch));
                ELSE
                    addch := ((INT(ch) - INT(CTRL_A_KEY)) / 256) + 1;
                    COPY_TEXT ("^");
                    COPY_TEXT (ASCII (addch + 64));
                ENDIF;
                cmd_str := cmd_str + ASCII (addch);
                cmd_idx := cmd_idx + 1;
                IF ch = 27 THEN ch := F11; ENDIF;
            ELSE
                IF (ch = UP) THEN
                    vi$next_in_cmd (cmd_str, cmd_idx, prompt, -1);
                ELSE
                    IF (ch = DOWN) THEN
                        vi$next_in_cmd (cmd_str, cmd_idx, prompt, 1);
                    ELSE
                        COPY_TEXT (ASCII(ch));
                        cmd_str := cmd_str + ASCII (ch);
                        cmd_idx := cmd_idx + 1;
                    ENDIF;
                ENDIF;
            ENDIF;
        ENDIF;
    ENDLOOP;

    ERASE_CHARACTER (LENGTH (CURRENT_LINE) - CURRENT_OFFSET);
    vi$update (CURRENT_WINDOW);

    IF (cmd_idx > 0) THEN
        POSITION (END_OF (command_buffer));
        LOOP
            MOVE_VERTICAL (-1);
            EXITIF (CURRENT_LINE <> prompt);
            ERASE_LINE;
        ENDLOOP;

        IF (CURRENT_LINE <> prompt + cmd_str) THEN
            MOVE_VERTICAL (1);
            COPY_TEXT (prompt + cmd_str);
        ENDIF;
    ENDIF;

    UNMAP (command_window);
    UNMAP (message_window);
    MAP (message_window, message_buffer);

    POSITION (win);
    POSITION (pos);

    RETURN (cmd_idx > 0);
ENDPROCEDURE;

!
!   This procedure looks from the next occurence of 'prompt' at the
!   beginning of the line, in the direction dir (1 or -1).  If prompt
!   is found, then cmd_str is set to the contents of that line, minus
!   the text of the prompt, and cmd_idx is set to the length of cmd_str.
!   The cursor is left positioned at the end of the line found, or if
!   none is found, it is not moved.
!
PROCEDURE vi$next_in_cmd (cmd_str, cmd_idx, prompt, dir)
    LOCAL
        pos,
        len;

    ON_ERROR
        POSITION (pos);
        RETURN;
    ENDON_ERROR;

    pos := MARK (NONE);
    len := LENGTH (prompt);

    POSITION (LINE_BEGIN);
    LOOP
        EXITIF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) AND (dir = -1);
        EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER)) AND (dir = 1);
        MOVE_VERTICAL (DIR);
        IF SUBSTR (CURRENT_LINE, 1, len) = prompt THEN
            cmd_str := SUBSTR (CURRENT_LINE, len+1,
                                            LENGTH (CURRENT_LINE) - len + 1);
            cmd_idx := LENGTH (cmd_str);
            POSITION (LINE_END);
            RETURN;
        ENDIF;
    ENDLOOP;
    POSITION (pos);
ENDPROCEDURE;

!
!   Perform a whole series of command separated by '|'s.
!
PROCEDURE vi$do_cmd_line (cmd)
    LOCAL
        ch,
        retval,
        idx,
        strg;

    idx := 1;
    strg := "";

    LOOP
        EXITIF (idx > LENGTH (cmd));
        ch := SUBSTR (cmd, idx, 1);
        IF (ch = "|") THEN
            retval := vi$do_command (strg);
            IF (retval > 1) THEN
                RETURN (retval);
            ENDIF;
            strg := "";
        ELSE
            IF (ch = "\") THEN
                idx := idx + 1;
                IF (SUBSTR (cmd, idx, 1) = "|") THEN
                    strg := strg + "|";
                ELSE
                    strg := strg + "\" + SUBSTR (cmd, idx, 1);
                ENDIF;
            ELSE
                strg := strg + ch;
            ENDIF;
        ENDIF;
        idx := idx + 1;
    ENDLOOP;

    IF (strg <> "") THEN
        IF (vi$do_command (strg) <> 0) THEN
            RETURN (1);
        ENDIF;
    ENDIF;
    RETURN (0);
ENDPROCEDURE;

!
!   Perform an EX (not all are implemented) command as given in "cmd".
!
PROCEDURE vi$do_command (cmd)
    LOCAL
        rng,
        outf,
        mode,
        token_1,
        token_2,
        token_3,
        res_spec,
        start_mark,
        end_mark,
        start_line,
        end_line,
        work_range,
        whole_range,
        buf,
        spos,
        rest,
        separ,
        no_spec,
        ch,
        i,
        j,
        olen,
        bang,
        num,
        pos;

    olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");

    ! Start at beginning of string and look for a range of lines.

    i := 1;

    pos := MARK (NONE);
    num := vi$get_line_spec (i, cmd);

    IF (num < 0) THEN
        vi$info ("search line not found!");
        POSITION (pos);
        RETURN (1);
    ENDIF;

    no_spec := 0;
    IF (num <= 0) THEN
        IF (vi$parse_next_ch (i, cmd, "%")) THEN
            start_line := 1;
            end_line := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
        ELSE
            no_spec := 1;
            start_line := vi$cur_line_no;
            end_line := start_line;
        ENDIF;
    ELSE
        start_line := num;
        IF (vi$parse_next_ch (i, cmd, ",")) THEN
            num := vi$get_line_spec (i, cmd);
            IF (num < 0) THEN
                vi$info ("Invalid line range specification!");
                RETURN (1);
            ENDIF;
            end_line := num;
        ELSE
            end_line := start_line;
        ENDIF;
    ENDIF;

    POSITION (pos);

    work_range := 0;
    whole_range := 0;

    IF (start_line > end_line) THEN
        vi$info ("Bad range of lines!");
        RETURN (1);
    ENDIF;

    start_mark := vi$mark_line (start_line);
    end_mark := vi$mark_line (end_line);

    IF (start_mark = 0) OR (end_mark = 0) THEN
        vi$info ("Bad range of lines!");
        RETURN (1);
    ENDIF;

    work_range := CREATE_RANGE (start_mark, end_mark, NONE);

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

    IF (end_mark <> END_OF (CURRENT_BUFFER)) THEN
        MOVE_VERTICAL (1);
    ENDIF;

    IF (end_mark <> BEGINNING_OF (CURRENT_BUFFER)) THEN
        MOVE_HORIZONTAL (-1);
    ENDIF;

    whole_range := CREATE_RANGE (start_mark, MARK (NONE), NONE);
    POSITION (pos);

    !   If there is no command then move to the line indicated.

    rest := vi$rest_of_line (cmd, i);
    EDIT (rest, COLLAPSE);
    IF rest = "" THEN
        vi$old_place := MARK (NONE);
        POSITION (start_mark);
        RETURN (0);
    ENDIF;

    token_1 := vi$get_cmd_token (vi$_lower_chars, cmd, i);

    IF (vi$leading_str (token_1, "version") AND (LENGTH (token_1) > 2)) THEN
        vi$info (vi$_version);
        RETURN (0);
    ENDIF;

    IF (token_1 = "help") THEN
        RETURN (vi$do_help (vi$rest_of_line (cmd, i)));
    ENDIF;

    IF (token_1 = "show") THEN
        RETURN (vi$do_show (cmd, i));
    ENDIF;

    ! Check for substitution alias.

    IF (token_1 = "") AND (vi$parse_next_ch (i, cmd, "&")) THEN
        RETURN (vi$do_subs_alias (cmd, i, start_line, end_line, whole_range));
    ENDIF;

    IF (token_1 = "") AND (vi$parse_next_ch (i, cmd, "@")) THEN
        RETURN (vi$do_macro_buffer (cmd, i));
    ENDIF;

    IF (token_1 = "learn") THEN
        RETURN (vi$do_learn (cmd, i));
    ENDIF;

    IF (token_1 = "unlearn") THEN
        RETURN (vi$do_unlearn (cmd, i));
    ENDIF;

    IF (token_1 = "v") THEN
        RETURN (vi$do_global (cmd, i, "v"));
    ENDIF;

    IF (token_1 = "g") THEN
        RETURN (vi$do_global (cmd, i, "g"));
    ENDIF;

    IF (token_1 = "sh") OR (token_1 = "dcl") THEN
        RETURN (vi$spawn (0));
    ENDIF;

    IF (vi$leading_str (token_1, "unabbr") AND (LENGTH (token_1) > 4)) THEN
        RETURN (vi$do_unabbr (cmd, i));
    ENDIF;

    IF (vi$leading_str (token_1, "abbr") AND (LENGTH (token_1) > 3)) THEN
        RETURN (vi$do_abbr (cmd, i));
    ENDIF;

    IF (vi$leading_str (token_1, "edit")) OR (token_1 = "vi") THEN
        RETURN (vi$do_edit (cmd, i, token_1));
    ENDIF;

    IF (token_1 = "") THEN
        IF (vi$parse_next_ch (i, cmd, "!")) THEN
            RETURN (vi$do_subproc (cmd, i));
        ENDIF;
    ENDIF;

    IF (vi$leading_str (token_1, "copy")) THEN
        RETURN (vi$do_copy (cmd, i, whole_range, olen, start_line, end_line));
    ENDIF;

    IF (vi$leading_str (token_1, "move")) THEN
        RETURN (vi$do_move (cmd, i, whole_range, start_line, end_line));
    ENDIF;

    IF (vi$leading_str (token_1, "select")) AND (LENGTH (token_1) > 2) THEN
        RETURN (vi$do_select);
    ENDIF;

    IF (token_1 = "fill") THEN
        RETURN (vi$do_fill (cmd, i, whole_range, olen));
    ENDIF;

    IF ((LENGTH (token_1) > 1) AND (vi$leading_str (token_1, "upper") OR
                                    vi$leading_str (token_1, "lower") OR
                                    vi$leading_str (token_1, "invert"))) THEN
        RETURN (vi$do_case (token_1, whole_range));
    ENDIF;

    IF (token_1 = "s") THEN
        RETURN (vi$do_substitute (start_line, end_line, whole_range, i, cmd));
    ENDIF;

    IF (token_1 = "d") THEN
        RETURN (vi$do_delete (start_mark, whole_range, olen));
    ENDIF;

    ! Do the write file command.  You can write either a buffer, or a
    ! portion of one.

    IF (vi$leading_str (token_1, "write")) THEN
        RETURN (vi$do_write (cmd, i, no_spec, token_1, whole_range));
    ENDIF;

    IF (token_1 = "wq") THEN
        RETURN (vi$do_wq (cmd, i, no_spec, token_1, whole_range));
    ENDIF;

    IF (token_1 = "p") THEN
        RETURN (vi$do_print (start_mark, start_line, end_line));
    ENDIF;

    ! Read in a file to the current buffer.

    IF (vi$leading_str (token_1, "read")) THEN
        RETURN (vi$do_read (cmd, i, start_line, olen));
    ENDIF;

    IF (vi$leading_str (token_1, "file")) THEN
        RETURN (vi$do_file_ex (cmd, i));
    ENDIF;

    IF (vi$leading_str (token_1, "buffer")) THEN
        RETURN (vi$do_buffer (cmd, i, token_1));
    ENDIF;

    IF (token_1 = "so") THEN
        RETURN (vi$do_file (vi$rest_of_line (cmd, i), 1));
    ENDIF;

    IF (vi$leading_str (token_1, "messages")) THEN
        RETURN (vi$do_messages);
    ENDIF;

    IF (vi$leading_str (token_1, "delbuf")) THEN
        RETURN (vi$do_delbuf (cmd, i));
    ENDIF;

    IF (vi$leading_str (token_1, "xit")) THEN
        RETURN (vi$_ZZ (KEY_NAME ('Z')));
    ENDIF;

    IF (token_1 = "rew") THEN
        RETURN (vi$_first_file (vi$parse_next_ch (i, cmd, "!")));
    ENDIF;

    IF (vi$leading_str (token_1, "prev")) THEN
        RETURN (vi$_previous_file (vi$parse_next_ch (i, cmd, "!")));
    ENDIF;

    IF (vi$leading_str (token_1, "next")) THEN
        RETURN (vi$_next_file (vi$parse_next_ch (i, cmd, "!")));
    ENDIF;

    IF (token_1 = "tag") OR (token_1 = "ta") THEN
        token_1 := vi$parse_next_ch (i, cmd, "!");
        vi$skip_white (cmd, i);
        IF (vi$rest_of_line (cmd, i) = "") THEN
            RETURN (vi$do_tag (0));
        ELSE
            RETURN (vi$do_tag (vi$rest_of_line (cmd, i)));
        ENDIF;
    ENDIF;

    IF (token_1 = "map") THEN
        RETURN (vi$map_keys (cmd, i));
    ENDIF;

    IF (token_1 = "unmap") THEN
        RETURN (vi$unmap_keys (cmd, i));
    ENDIF;

    IF (token_1 = "set") OR (token_1 = "se") THEN
        RETURN (vi$set_commands (cmd, i));
    ENDIF;

    IF (token_1 = "tpu") THEN
        RETURN (vi$do_tpu (cmd, i, no_spec, whole_range));
    ENDIF;

    IF (token_1 = "cd") OR (token_1 = "chdir") THEN
        RETURN (vi$do_cd (cmd, i));
    ENDIF;

    ! Quit the current editor session.

    IF (vi$leading_str (token_1, "quit")) THEN
        RETURN (vi$do_quit (cmd, token_1));
    ENDIF;

    vi$info ("Unrecognized command! ("+cmd+")");
    RETURN (1);
ENDPROCEDURE;

!
!
!
PROCEDURE vi$do_unlearn (cmd, i)
    LOCAL
        keyn,
        com;

    vi$info ("Press the key you want to unlearn: ");
    keyn := vi$read_a_key;

    IF (keyn = F11) OR (ASCII (27) = ASCII (keyn)) THEN
        vi$info ("UNLEARN aborted!");
        RETURN (1);
    ENDIF;

    com := LOOKUP_KEY (keyn, COMMENT, vi$cmd_keys);
    IF (com <> "learn_sequence") THEN
        vi$info ("That key is not a learned KEY!");
        RETURN (1);
    ENDIF;

    UNDEFINE_KEY (keyn, vi$cmd_keys);
ENDPROCEDURE;

!
!
!
PROCEDURE vi$do_learn (cmd, i)
    LOCAL
        keyn,
        strg;

    vi$info ("Type KEY sequence, and press CTRL-R to remember sequence");
    vi$in_learn := 1;
    LEARN_BEGIN (EXACT);
    RETURN (1);
ENDPROCEDURE;

!
!   Remember the keystrokes that have been typed.
!
PROCEDURE vi$remember

    LOCAL
        key,
        keyn,
        com;

    ON_ERROR
        RETURN (1);
    ENDON_ERROR;

    IF (vi$in_learn = 0) THEN
        RETURN (0);
    ENDIF;

$$EOD$$



More information about the Comp.sources.misc mailing list