home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume1 / 8710 / vms-vi / 9 < prev    next >
Encoding:
Internet Message Format  |  1990-07-13  |  36.2 KB
  1. Path: uunet!husc6!necntc!ncoast!allbery
  2. From: gregg@a.cs.okstate.edu@mandrill.CWRU.Edu (Gregg Wonderly)
  3. Newsgroups: comp.sources.misc
  4. Subject: VI in TPU part 9/13
  5. Message-ID: <4858@ncoast.UUCP>
  6. Date: 13 Oct 87 02:54:02 GMT
  7. Sender: allbery@ncoast.UUCP
  8. Organization: Oklahoma State Univ., Stillwater
  9. Lines: 1500
  10. Approved: allbery@ncoast.UUCP
  11. X-Archive: comp.sources.misc/8710/vms-vi/9
  12.  
  13. $ WRITE SYS$OUTPUT "Creating ""VI.8"""
  14. $ CREATE VI.8
  15. $ DECK/DOLLARS=$$EOD$$
  16.     POSITION (pos);
  17.     DELETE (buf);
  18.  
  19.     vi$message ("Key now unmapped!");
  20. ENDPROCEDURE;
  21.  
  22. !
  23. !   Show current keyboard mappings.
  24. !
  25. PROCEDURE vi$show_maps
  26.     LOCAL
  27.         com,
  28.         key_type,
  29.         keyn,
  30.         key,
  31.         bpos,
  32.         npos,
  33.         pos,
  34.         buf;
  35.  
  36.     pos := MARK (NONE);
  37.     buf := choice_buffer;
  38.  
  39.     POSITION (buf);
  40.     ERASE (buf);
  41.  
  42.     key_type := vi$cmd_keys;
  43.     COPY_TEXT ("COMMAND KEY MAPS:");
  44.     SPLIT_LINE;
  45.     LOOP
  46.         keyn := GET_INFO (DEFINED_KEY, "first", key_type);
  47.         LOOP
  48.             EXITIF (keyn = 0);
  49.             com := LOOKUP_KEY (keyn, COMMENT, key_type);
  50.  
  51.             IF (com = "active_macro") THEN
  52.                 key := vi$key_map_name (keyn);
  53.                 vi$global_var := 0;
  54.                 EXECUTE (COMPILE ("vi$global_var:=vi$$key_map_buf_"+
  55.                                                             key+key_type));
  56.                 IF (vi$global_var <> 0) AND
  57.                         (GET_INFO (vi$global_var, "TYPE") = BUFFER) THEN
  58.                     key := vi$ascii_name (keyn);
  59.                     COPY_TEXT (" "+key+SUBSTR ("   ", 1, 4-LENGTH(key))+'"');
  60.                     npos := MARK (NONE);
  61.                     POSITION (BEGINNING_OF (vi$global_var));
  62.                     LOOP
  63.                         keyn := CURRENT_LINE;
  64.                         EXITIF (LENGTH (keyn) < 8);
  65.                         bpos := MARK (NONE);
  66.                         POSITION (npos);
  67.                         COPY_TEXT (vi$ascii_name (INT(keyn)));
  68.                         POSITION (bpos);
  69.                         MOVE_VERTICAL (1);
  70.                     ENDLOOP;
  71.                     POSITION (npos);
  72.                     COPY_TEXT ('"');
  73.                     SPLIT_LINE;
  74.                 ENDIF;
  75.             ENDIF;
  76.             keyn := GET_INFO (DEFINED_KEY, "next", key_type);
  77.         ENDLOOP;
  78.         EXITIF (key_type = vi$edit_keys);
  79.         key_type := vi$edit_keys;
  80.         SPLIT_LINE;
  81.         COPY_TEXT ("EDITING KEY MAPS:");
  82.         SPLIT_LINE;
  83.     ENDLOOP;
  84.  
  85.     APPEND_LINE;
  86.     POSITION (BEGINNING_OF (buf));
  87.     POSITION (pos);
  88.     vi$show_list (buf,
  89.         "                                 Current MAPPINGS" +
  90.         "                           ",
  91.         info_window);
  92.     RETURN (0);
  93.  
  94. ENDPROCEDURE;
  95.  
  96. !
  97. !   Generate a unique string based on a KEY_NAME value.
  98. !
  99. PROCEDURE vi$key_map_name (key)
  100.     RETURN (SUBSTR(FAO("!XL", key),1,6));
  101. ENDPROCEDURE;
  102.  
  103. !
  104. !   Increment "i" until it is no longer indexing a blank or tab in "cmd".
  105. !
  106. PROCEDURE vi$skip_white (cmd, i)
  107.  
  108.     LOOP
  109.         EXITIF i > LENGTH (cmd);
  110.         EXITIF (INDEX ("    ", SUBSTR(cmd, i, 1)) = 0);
  111.         i := i + 1;
  112.     ENDLOOP;
  113. ENDPROCEDURE;
  114.  
  115. !
  116. !   Given a string, extract a line specification that is either absolute,
  117. !   relative, or an RE pattern expression.
  118. !
  119. PROCEDURE vi$get_line_spec (idx, cmd)
  120.     LOCAL
  121.         ch,
  122.         sch,
  123.         num;
  124.  
  125.     num := -1;
  126.  
  127.     ch := SUBSTR (cmd, idx, 1);
  128.  
  129.     IF (ch = "/") OR (ch = "?") THEN
  130.         idx := idx + 1;
  131.         sch := ch;
  132.         num := "";
  133.         LOOP
  134.             EXITIF (vi$parse_next_ch (idx, cmd, sch));
  135.             EXITIF (LENGTH (cmd) < idx);
  136.             ch := SUBSTR (cmd, idx, 1);
  137.             IF (ch = "\") THEN
  138.                 num := num + SUBSTR (cmd, idx, 2);
  139.                 idx := idx + 1;
  140.             ELSE
  141.                 num := num + ch;
  142.             ENDIF;
  143.             idx := idx + 1;
  144.         ENDLOOP;
  145.  
  146.         IF (LENGTH (cmd) < idx - 1) THEN
  147.             MESSAGE ("Oops, improper expression!");
  148.             RETURN (-1);
  149.         ENDIF;
  150.  
  151.         ch := SUBSTR (cmd, idx, 1);
  152.  
  153.         IF sch = "?" THEN
  154.             SET (REVERSE, CURRENT_BUFFER);
  155.         ELSE
  156.             SET (FORWARD, CURRENT_BUFFER);
  157.         ENDIF;
  158.  
  159.         num := vi$find_str (num, 0);
  160.  
  161.         IF (num <> 0) THEN
  162.             num := BEGINNING_OF (num);
  163.             POSITION (num);
  164.             num := vi$cur_line_no;
  165.         ELSE
  166.             num := -1;
  167.         ENDIF;
  168.     ELSE
  169.         LOOP
  170.             ch := SUBSTR (cmd, idx, 1);
  171.             EXITIF (INDEX (vi$_numeric_chars, ch) = 0);
  172.             IF (num < 0) THEN
  173.                 num := INT (ch);
  174.             ELSE
  175.                 num := num * 10 + INT (ch);
  176.             ENDIF;
  177.             idx := idx + 1;
  178.         ENDLOOP;
  179.     ENDIF;
  180.  
  181.     IF (ch = ".") THEN
  182.         num := vi$cur_line_no;
  183.         idx := idx + 1;
  184.         IF (vi$parse_next_ch (idx, cmd, "+")) THEN
  185.             num := num + vi$get_line_spec (idx, cmd);
  186.         ENDIF;
  187.     ELSE
  188.         IF (ch = "$") THEN
  189.             num := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
  190.             idx := idx + 1;
  191.         ELSE
  192.             IF (ch = "+") THEN
  193.                 num := num + vi$get_line_spec (idx, cmd);
  194.             ENDIF;
  195.         ENDIF;
  196.     ENDIF;
  197.  
  198.     RETURN (num);
  199. ENDPROCEDURE;
  200.  
  201. !
  202. !   If the character at location "idx" in "cmd" is "try", then increment
  203. !   "idx" and return TRUE, otherwise return FALSE.
  204. !
  205. PROCEDURE vi$parse_next_ch (idx, cmd, try)
  206.     IF (SUBSTR (cmd, idx, 1) = try) THEN
  207.         idx := idx + 1;
  208.         RETURN (1);
  209.     ENDIF;
  210.  
  211.     RETURN (0);
  212. ENDPROCEDURE;
  213.  
  214. !
  215. !   A function to get the string, in "cmd", that is spanned by the characters
  216. !   in "mask".  "idx" is incremented to point past this string, and the string
  217. !   is returned as the function value.
  218. !
  219. PROCEDURE vi$get_cmd_token (mask, cmd, idx)
  220.     LOCAL
  221.         token,
  222.         ch;
  223.  
  224.     token := "";
  225.  
  226.     vi$skip_white (cmd, idx);
  227.  
  228.     LOOP
  229.         EXITIF (idx > LENGTH (cmd));
  230.         ch := SUBSTR (cmd, idx, 1);
  231.         EXITIF (INDEX (mask, ch) = 0);
  232.         token := token + ch;
  233.         idx := idx + 1;
  234.     ENDLOOP;
  235.  
  236.     RETURN (token);
  237. ENDPROCEDURE;
  238.  
  239. !
  240. !   A function to see if the string "token" is a lead substring of "cmd".
  241. !
  242. PROCEDURE vi$leading_str (token, cmd)
  243.     RETURN ((token <> "") AND (INDEX (cmd, token) = 1));
  244. ENDPROCEDURE;
  245.  
  246. !
  247. !   A routine that looks for the first occurance of a character in
  248. !   "seps", in "cmd", and then changes "idx" to reflect that locatation.
  249. !   "separ" will contain the character in "seps" that was actually found.
  250. !
  251. PROCEDURE vi$skip_separ (cmd, idx, seps, separ)
  252.     LOCAL
  253.         nch,
  254.         retstr;
  255.  
  256.     retstr := "";
  257.     separ := "";
  258.     vi$skip_white (cmd, idx);
  259.  
  260.     LOOP
  261.         EXITIF (idx > LENGTH (cmd));
  262.         nch := SUBSTR (cmd, idx, 1);
  263.         idx := idx + 1;
  264.         IF (INDEX (seps, nch) <> 0) OR (nch = " ") OR (nch = "  ") THEN
  265.             separ := nch;
  266.             RETURN (retstr);
  267.         ENDIF;
  268.         retstr := retstr + nch;
  269.     ENDLOOP;
  270.     RETURN (retstr);
  271. ENDPROCEDURE;
  272.  
  273. !
  274. !   A procedure that returns the characters occuring at index, "idx", and
  275. !   after in the string "cmd".
  276. !
  277. PROCEDURE vi$rest_of_line (cmd, idx)
  278.     RETURN (SUBSTR (cmd, idx, LENGTH (cmd)-idx + 1));
  279. ENDPROCEDURE;
  280.  
  281. !
  282. !  SET (INFORMATIONAL/SUCCESS) short procedures.
  283. !
  284. PROCEDURE vi$info_success_off vi$info_off; vi$success_off; ENDPROCEDURE;
  285. PROCEDURE vi$info_success_on vi$info_on; vi$success_on; ENDPROCEDURE;
  286. PROCEDURE vi$success_off SET (SUCCESS, OFF); ENDPROCEDURE;
  287. PROCEDURE vi$success_on SET (SUCCESS, ON); ENDPROCEDURE;
  288. PROCEDURE vi$info_off SET (INFORMATIONAL, OFF); ENDPROCEDURE;
  289. PROCEDURE vi$info_on SET (INFORMATIONAL, ON); ENDPROCEDURE;
  290.  
  291. !
  292. !   Called from vi$do_global to perform a substitution during a global command.
  293. !
  294. PROCEDURE vi$global_subs (cmd, nsubs)
  295.  
  296.     LOCAL
  297.         idx,
  298.         result_text,
  299.         replace_text,
  300.         hrange,
  301.         ch,
  302.         pos,
  303.         spos,
  304.         epos,
  305.         lpos,
  306.         source,
  307.         scount,
  308.         dest,
  309.         query,
  310.         global,
  311.         replace,
  312.         separ;
  313.  
  314.     idx := 1;
  315.  
  316.     separ := vi$next_char (cmd, idx);
  317.  
  318.     source := "";
  319.     dest   := "";
  320.     global := 0;
  321.     query  := 0;
  322.  
  323.     LOOP
  324.         IF (idx > LENGTH (cmd)) THEN
  325.             vi$message ("Insufficent arguments!");
  326.             RETURN (0);
  327.         ENDIF;
  328.  
  329.         ch := SUBSTR (cmd, idx, 1);
  330.         EXITIF ch = separ;
  331.         source := source + ch;
  332.         idx := idx + 1;
  333.     ENDLOOP;
  334.  
  335.     idx := idx + 1;
  336.     LOOP
  337.         EXITIF idx > LENGTH (cmd);
  338.         ch := SUBSTR (cmd, idx, 1);
  339.         EXITIF ch = separ;
  340.         dest := dest + ch;
  341.         idx := idx + 1;
  342.     ENDLOOP;
  343.  
  344.     idx := idx + 1;
  345.     LOOP
  346.         EXITIF idx > LENGTH (cmd);
  347.         ch := SUBSTR (cmd, idx, 1);
  348.         IF ch = "q" THEN
  349.             query := 1;
  350.         ELSE
  351.             IF ch = "g" THEN
  352.                 global := 1;
  353.             ELSE
  354.                 vi$message ("Unrecognized command qualifier '"+ch+"'");
  355.                 RETURN (0);
  356.             ENDIF;
  357.         ENDIF;
  358.         idx := idx + 1;
  359.     ENDLOOP;
  360.  
  361.     vi$replace_source := source;
  362.     vi$replace_dest := dest;
  363.  
  364.     lpos := vi$perform_subs (source, dest, vi$cur_line_no,
  365.                                                 scount, global, query);
  366.     nsubs := nsubs + scount;
  367.  
  368.     RETURN (lpos);
  369. ENDPROCEDURE;
  370. !
  371. !   Called from vi$do_command to parse the rest of the command line,
  372. !   this procedure then envokes lower level routines to perform the work
  373. !   of a substitution command.
  374. !
  375. PROCEDURE vi$do_substitute (start_line, end_line, whole_range, idx, cmd)
  376.  
  377.     LOCAL
  378.         result_text,
  379.         replace_text,
  380.         hrange,
  381.         ch,
  382.         pos,
  383.         spos,
  384.         epos,
  385.         lpos,
  386.         source,
  387.         scount,
  388.         dest,
  389.         query,
  390.         global,
  391.         replace,
  392.         separ;
  393.  
  394.     pos := MARK (NONE);
  395.     POSITION (END_OF (whole_range));
  396.     epos := MARK (NONE);
  397.     POSITION (pos);
  398.  
  399.     separ := vi$next_char (cmd, idx);
  400.     vi$replace_separ := separ;
  401.  
  402.     source := "";
  403.     dest   := "";
  404.     global := 0;
  405.     query  := 0;
  406.  
  407.     MESSAGE ("");
  408.     LOOP
  409.         IF (idx > LENGTH (cmd)) THEN
  410.             vi$message ("Insufficent arguments!");
  411.             RETURN (1);
  412.         ENDIF;
  413.  
  414.         ch := SUBSTR (cmd, idx, 1);
  415.         EXITIF ch = separ;
  416.         source := source + ch;
  417.         idx := idx + 1;
  418.     ENDLOOP;
  419.  
  420.     idx := idx + 1;
  421.     LOOP
  422.         EXITIF idx > LENGTH (cmd);
  423.         ch := SUBSTR (cmd, idx, 1);
  424.         EXITIF ch = separ;
  425.         dest := dest + ch;
  426.         idx := idx + 1;
  427.     ENDLOOP;
  428.  
  429.     idx := idx + 1;
  430.     LOOP
  431.         EXITIF idx > LENGTH (cmd);
  432.         ch := SUBSTR (cmd, idx, 1);
  433.         IF ch = "q" THEN
  434.             query := 1;
  435.         ELSE
  436.             IF ch = "g" THEN
  437.                 global := 1;
  438.             ELSE
  439.                 vi$message ("Unrecognized command qualifier '"+ch+"'");
  440.                 RETURN (1);
  441.             ENDIF;
  442.         ENDIF;
  443.         idx := idx + 1;
  444.     ENDLOOP;
  445.  
  446.     POSITION (pos);
  447.     vi$save_for_undo (whole_range, VI$LINE_MODE, 1);
  448.     vi$move_to_line (start_line);
  449.  
  450.     IF MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER) THEN
  451.         MOVE_HORIZONTAL (-1);
  452.         spos := MARK (NONE);
  453.         MOVE_HORIZONTAL (1);
  454.     ELSE
  455.         spos := 0;
  456.     ENDIF;
  457.  
  458.     vi$replace_source := source;
  459.     vi$replace_dest := dest;
  460.  
  461.     lpos := vi$perform_subs (source, dest, end_line, scount, global, query);
  462.  
  463.     IF (scount = 0) THEN
  464.         vi$kill_undo;
  465.         vi$undo_end := 0;
  466.         POSITION (pos);
  467.     ELSE
  468.         vi$undo_end := epos;
  469.         IF (spos = 0) THEN
  470.             vi$undo_start := BEGINNING_OF (CURRENT_BUFFER);
  471.         ELSE
  472.             POSITION (spos);
  473.             MOVE_HORIZONTAL (1);
  474.             vi$undo_start := MARK (NONE);
  475.         ENDIF;
  476.         vi$pos_in_middle (lpos);
  477.         MESSAGE (FAO ("!UL substitution!%S!", scount));
  478.     ENDIF;
  479.  
  480.     RETURN (1);
  481. ENDPROCEDURE;
  482.  
  483. !
  484. !   Repeat the last substitute command that was issued at the ":" prompt.
  485. !
  486. !   The function mapped to '&'.
  487. !
  488. PROCEDURE vi$repeat_subs
  489.     LOCAL
  490.         scount,
  491.         global,
  492.         query,
  493.         lpos,
  494.         spos,
  495.         pos,
  496.         epos,
  497.         here;
  498.  
  499.     IF (vi$replace_separ = 0) THEN
  500.         vi$message ("No previous substitution!");
  501.         RETURN;
  502.     ENDIF;
  503.  
  504.     global := 0;
  505.     query := 0;
  506.     here := vi$cur_line_no;
  507.     vi$save_for_undo (CURRENT_LINE, VI$LINE_MODE, 1);
  508.  
  509.     pos := MARK (NONE);
  510.     MOVE_HORIZONTAL (-CURRENT_OFFSET);
  511.  
  512.     spos := vi$get_undo_start;
  513.  
  514.     MOVE_HORIZONTAL (LENGTH (CURRENT_LINE));
  515.     IF (LENGTH (CURRENT_LINE) > 0) THEN
  516.         MOVE_HORIZONTAL (-1);
  517.     ENDIF;
  518.     epos := MARK (NONE);
  519.     POSITION (pos);
  520.  
  521.     lpos := vi$perform_subs (vi$replace_source, vi$replace_dest,
  522.                                                 here, scount, global, query);
  523.  
  524.     IF (scount = 0) THEN
  525.         vi$kill_undo;
  526.         vi$undo_end := 0;
  527.     ELSE
  528.         vi$undo_end := epos;
  529.         vi$undo_start := vi$set_undo_start (spos);
  530.         POSITION (lpos);
  531.     ENDIF;
  532.  
  533. ENDPROCEDURE;
  534.  
  535. !
  536. !   Perform a substitution from the current location to "end_line".
  537. !   Use source as the search string, and dest as the substitution
  538. !   spec.  "global" indicates whether or not all occurances on a line
  539. !   are examined, and "query" indicates whether or not to prompt before
  540. !   performing the substitution.  On return, "scount" will hold the
  541. !   number of substitutions actually performed.
  542. !
  543. PROCEDURE vi$perform_subs (source, dest, end_line, scount, global, query)
  544.  
  545.     LOCAL
  546.         result_text,
  547.         replace_text,
  548.         answer,
  549.         fcnt,
  550.         lpos,
  551.         hrange,
  552.         replace,
  553.         fpos,
  554.         quit_now,
  555.         cwin,
  556.         pos;
  557.  
  558.     SET (FORWARD, CURRENT_BUFFER);
  559.     scount := 0;
  560.     fcnt := 0;
  561.     quit_now := 0;
  562.     pos := MARK (NONE);
  563.  
  564.     LOOP
  565.         fpos := vi$find_str (source, 1);
  566.         EXITIF (fpos = 0);
  567.         fcnt := fcnt + 1;
  568.         POSITION (BEGINNING_OF (fpos));
  569.  
  570.         IF vi$cur_line_no > end_line THEN
  571.             POSITION (pos);
  572.             EXITIF (1);
  573.         ENDIF;
  574.         result_text := SUBSTR (fpos, 1, LENGTH (fpos));
  575.         replace_text := vi$substitution (result_text, dest);
  576.         POSITION (BEGINNING_OF (fpos));
  577.  
  578.         replace := 1;
  579.         IF (query) THEN
  580.             POSITION (BEGINNING_OF (fpos));
  581.             hrange := CREATE_RANGE (BEGINNING_OF (fpos),
  582.                                                     END_OF (fpos), REVERSE);
  583.             cwin := GET_INFO (WINDOWS, "FIRST");
  584.             LOOP
  585.                 EXITIF (cwin = 0);
  586.                 IF (GET_INFO (cwin, "VISIBLE")) THEN
  587.                     UPDATE (cwin);
  588.                 ENDIF;
  589.                 cwin := GET_INFO (WINDOWS, "NEXT");
  590.             ENDLOOP;
  591.  
  592.             answer := vi$read_line ("Replace y/n/a/q? ");
  593.  
  594.             CHANGE_CASE (answer, LOWER);
  595.             IF (answer = "") OR (INDEX ("yes", answer) <> 1) THEN
  596.                 replace := 0;
  597.             ENDIF;
  598.             IF (INDEX ("quit", answer) = 1) THEN
  599.                 quit_now := 1;
  600.             ENDIF;
  601.             IF (INDEX ("all", answer) = 1) THEN
  602.                 query := 0;
  603.             ENDIF;
  604.         ENDIF;
  605.  
  606.         IF replace THEN
  607.  
  608. !           This is a hack necessary to fix TPU's pattern matching.
  609. !           The length of the text match by only "line_begin" has
  610. !           length == 1 instead of 0 as one would expect.
  611.  
  612.             IF (source <> "^") THEN
  613.                 ERASE_CHARACTER (LENGTH (result_text));
  614.             ENDIF;
  615.             COPY_TEXT (replace_text);
  616.             pos := MARK (NONE);
  617.             scount := scount + 1;
  618.         ELSE
  619.             MOVE_HORIZONTAL (1);
  620.         ENDIF;
  621.  
  622.         IF NOT global THEN
  623.             MOVE_HORIZONTAL (-CURRENT_OFFSET);
  624.             EXITIF MARK (NONE) = END_OF (CURRENT_BUFFER);
  625.             MOVE_VERTICAL (1);
  626.         ENDIF;
  627.         EXITIF quit_now;
  628.     ENDLOOP;
  629.  
  630.     IF fcnt = 0 THEN
  631.         MESSAGE ("string not found!");
  632.     ENDIF;
  633.  
  634.     RETURN (pos);
  635. ENDPROCEDURE;
  636.  
  637. !
  638. !   Move horizontal, ignoring errors
  639. !
  640. PROCEDURE vi$move_horizontal (cnt)
  641.     ON_ERROR
  642.     ENDON_ERROR;
  643.  
  644.     MOVE_HORIZONTAL (cnt);
  645. ENDPROCEDURE;
  646.  
  647. !
  648. !   Move vertical, ignoring errors
  649. !
  650. PROCEDURE vi$move_vertical (cnt)
  651.     ON_ERROR
  652.     ENDON_ERROR;
  653.  
  654.     MOVE_VERTICAL (cnt);
  655. ENDPROCEDURE;
  656.  
  657. !
  658. !   Move to the indicated line number.
  659. !
  660. PROCEDURE vi$move_to_line (line_no)
  661.     LOCAL
  662.         pos;
  663.  
  664.     ON_ERROR
  665.         POSITION (pos);
  666.         RETURN (0);
  667.     ENDON_ERROR;
  668.  
  669.     pos := MARK (NONE);
  670.     POSITION (BEGINNING_OF (CURRENT_BUFFER));
  671.     MOVE_VERTICAL (line_no - 1);
  672.  
  673.     RETURN (MARK (NONE));
  674. ENDPROCEDURE;
  675.  
  676. !
  677. !   Give a source string, and a "dest" substitution spec, perform the
  678. !   RE style substitution, and return the resultant string.
  679. !
  680. PROCEDURE vi$substitution (source, dest)
  681.  
  682.     LOCAL
  683.         cur_char,
  684.         result,
  685.         idx;
  686.  
  687.     idx := 0;
  688.     result := "";
  689.  
  690.     LOOP
  691.         EXITIF (idx > LENGTH(dest));
  692.  
  693.         cur_char := SUBSTR (dest, idx, 1);
  694.         IF (cur_char = "&") THEN
  695.             result := result + source;
  696.             idx := idx + 1;
  697.         ELSE
  698.             IF (cur_char = '\') THEN
  699.                 cur_char := SUBSTR(dest, idx+1, 1);
  700.                 IF (INDEX ("123456789", cur_char) > 0) THEN
  701.                     IF INT(cur_char) > 1 THEN
  702.                         EXECUTE (COMPILE ("vi$glo_str := SUBSTR (p" +
  703.                             cur_char +", LENGTH (o"+cur_char+")+1,512);"));
  704.                     ELSE
  705.                         EXECUTE (COMPILE ("vi$glo_str := SUBSTR (p" +
  706.                             cur_char +", LENGTH (o"+cur_char+"),512);"));
  707.                     ENDIF;
  708.                     result := result + vi$glo_str;
  709.                 ELSE
  710.                     result := result + "\" + cur_char;
  711.                 ENDIF;
  712.                 idx := idx + 2;
  713.             ELSE
  714.                 result := result + cur_char;
  715.                 idx := idx + 1;
  716.             ENDIF;
  717.         ENDIF;
  718.     ENDLOOP;
  719.  
  720.     RETURN (result);
  721. ENDPROCEDURE;
  722.  
  723. !
  724. !   Get the next character from a string at idx, and point past the character
  725. !
  726. PROCEDURE vi$next_char (cmd, idx)
  727.  
  728.     IF idx <= LENGTH (cmd) THEN
  729.         idx := idx + 1;
  730.         RETURN (SUBSTR (cmd, idx -1, 1));
  731.     ENDIF;
  732.  
  733.     RETURN ("");
  734. ENDPROCEDURE;
  735.  
  736. !
  737. !  Process all set commands in the string cmd
  738. !
  739. PROCEDURE vi$set_commands (cmd, i)
  740.     LOCAL
  741.         err,
  742.         separ,
  743.         token_1;
  744.  
  745.     ON_ERROR
  746.         RETURN;
  747.     ENDON_ERROR;
  748.  
  749.     LOOP
  750.         token_1 := vi$skip_separ (cmd, i, "=    ", separ);
  751.         EDIT (token_1, COLLAPSE);
  752.  
  753.         EXITIF token_1 = "";
  754.  
  755.         err :=  vi$set_one (token_1, separ, cmd, i);
  756.         EXITIF err;
  757.     ENDLOOP;
  758.     RETURN (err);
  759. ENDPROCEDURE
  760.  
  761. !
  762. !  Process a single set command and return success or failure.
  763. !
  764. PROCEDURE vi$set_one (token_1, separ, cmd, i)
  765.  
  766.     LOCAL
  767.         val,
  768.         errno,
  769.         curwin,
  770.         curbuf,
  771.         buf,
  772.         use_fortran,
  773.         oldscrlen,
  774.         npat,
  775.         pstr,
  776.         token_2;
  777.  
  778.     ON_ERROR
  779.         errno := ERROR;
  780.         MESSAGE ("ERROR at line: "+STR(ERROR_LINE)+", "+
  781.                                 call_user(vi$cu_getmsg,STR(errno)));
  782.         RETURN (1);
  783.     ENDON_ERROR;
  784.  
  785.     token_2 := "";
  786.  
  787.     IF (token_1 = "all") THEN
  788.         vi$show_settings;
  789.         RETURN (0);
  790.     ENDIF;
  791.  
  792.     IF (token_1 = "tags") THEN
  793.         vi$tag_files := vi$rest_of_line (cmd, i);
  794.         i := LENGTH (cmd) + 1;
  795.         RETURN (vi$load_tags);
  796.     ENDIF;
  797.  
  798.     IF (token_1 = "notagcase") OR (token_1 = "notc") THEN
  799.         vi$tag_case := NO_EXACT;
  800.         RETURN (0);
  801.     ENDIF;
  802.  
  803.     IF (token_1 = "tagcase") OR (token_1 = "tc") THEN
  804.         vi$tag_case := EXACT;
  805.         RETURN (0);
  806.     ENDIF;
  807.  
  808.     IF (token_1 = "senddcl") THEN
  809.         vi$send_dcl := 1;
  810.         RETURN (0);
  811.     ENDIF;
  812.  
  813.     IF (token_1 = "nosenddcl") THEN
  814.         vi$send_dcl := 0;
  815.         RETURN (0);
  816.     ENDIF;
  817.  
  818.     IF (token_1 = "files") OR (token_1 = "file") THEN
  819.         val := vi$expand_file_list (vi$rest_of_line (cmd, i));
  820.         MESSAGE (FAO ("!UL file!%S selected", val, 0));
  821.         RETURN (2);
  822.     ENDIF;
  823.  
  824.     IF (token_1 = "notabs") THEN
  825.         vi$use_tabs := 0;
  826.         RETURN (0);
  827.     ENDIF;
  828.  
  829.     IF (token_1 = "tabs") THEN
  830.         vi$use_tabs := 1;
  831.         RETURN (0);
  832.     ENDIF;
  833.  
  834.     IF (token_1 = "write") OR (token_1 = "wr") THEN
  835.         SET (NO_WRITE, CURRENT_BUFFER, OFF);
  836.         vi$status_lines (CURRENT_BUFFER);
  837.         RETURN (0);
  838.     ENDIF;
  839.  
  840.     IF (token_1 = "nowrite") OR (token_1 = "nowr") THEN
  841.         SET (NO_WRITE, CURRENT_BUFFER, ON);
  842.         vi$status_lines (CURRENT_BUFFER);
  843.         RETURN (0);
  844.     ENDIF;
  845.  
  846.     IF (token_1 = "width") THEN
  847.         token_2 := vi$skip_separ (cmd, i, "=    ", separ);
  848.         val := INT (token_2);
  849.         SET (WIDTH, CURRENT_WINDOW, val);
  850.         vi$scr_width := val;
  851.         RETURN (0);
  852.     ENDIF;
  853.  
  854.     IF (token_1 = "window") THEN
  855.         token_2 := vi$skip_separ (cmd, i, "=    ", separ);
  856.         val := INT (token_2);
  857.         RETURN (vi$do_set_window (val));
  858.     ENDIF;
  859.  
  860.     IF (token_1 = "ts") OR (token_1 = "tabstops") THEN
  861.         token_2 := vi$skip_separ (cmd, i, "=   ", separ);
  862.         val := INT (token_2);
  863.         SET (TAB_STOPS, CURRENT_BUFFER, val);
  864.         vi$tab_amount := val;
  865.         RETURN (0);
  866.     ENDIF;
  867.  
  868.     IF (token_1 = "sw") OR (token_1 = "shiftwidth") then
  869.         token_2 := vi$skip_separ (cmd, i, "=    ", separ);
  870.         vi$shift_width := INT (token_2);
  871.         RETURN (0);
  872.     ENDIF;
  873.  
  874.     IF (token_1 = "noundomap") OR (token_1 = "noum") THEN
  875.         vi$undo_map := 0;
  876.         RETURN (0);
  877.     ENDIF;
  878.  
  879.     IF (token_1 = "undomap") OR (token_1 = "um") THEN
  880.         vi$undo_map := 1;
  881.         RETURN (0);
  882.     ENDIF;
  883.  
  884.     IF (token_1 = "scroll") THEN
  885.         token_2 := vi$skip_separ (cmd, i, "=    ", separ);
  886.         vi$how_much_scroll := INT (token_2);
  887.         RETURN (0);
  888.     ENDIF;
  889.  
  890.     IF (token_1 = "report") THEN
  891.         token_2 := vi$skip_separ (cmd, i, "=    ", separ);
  892.         vi$report := INT (token_2);
  893.         RETURN (0);
  894.     ENDIF;
  895.  
  896.     IF (token_1 = "aw") OR (token_1 = "autowrite") THEN
  897.         vi$auto_write := 1;
  898.         RETURN (0);
  899.     ENDIF;
  900.  
  901.     IF (token_1 = "noaw") OR (token_1 = "noautowrite") THEN
  902.         vi$auto_write := 0;
  903.         RETURN (0);
  904.     ENDIF;
  905.  
  906.     IF (token_1 = "noic") OR (token_1 = "noignorecase") THEN
  907.         vi$ignore_case := EXACT;
  908.         RETURN (0);
  909.     ENDIF;
  910.  
  911.     IF (token_1 = "ic") OR (token_1 = "ignorecase") THEN
  912.         vi$ignore_case := NO_EXACT;
  913.         RETURN (0);
  914.     ENDIF;
  915.  
  916.     IF (token_1 = "magic") THEN
  917.         vi$magic := 1;
  918.         RETURN (0);
  919.     ENDIF;
  920.  
  921.     IF (token_1 = "nomagic") THEN
  922.         vi$magic := 0;
  923.         RETURN (0);
  924.     ENDIF;
  925.  
  926.     IF (token_1 = "noerrorbells") OR (token_1 = "noeb") THEN
  927.         vi$error_bells := 0;
  928.         RETURN (0);
  929.     ENDIF;
  930.  
  931.     IF (token_1 = "errorbells") OR (token_1 = "eb") THEN
  932.         vi$error_bells := 1;
  933.         RETURN (0);
  934.     ENDIF;
  935.  
  936.     IF (token_1 = "nowrapscan") OR (token_1 = "nows") THEN
  937.         vi$wrap_scan := 0;
  938.         RETURN (0);
  939.     ENDIF;
  940.  
  941.     IF (token_1 = "wrapscan") OR (token_1 = "ws") THEN
  942.         vi$wrap_scan := 1;
  943.         RETURN (0);
  944.     ENDIF;
  945.  
  946.     IF (token_1 = "noupdate") THEN
  947.         vi$min_update := 1;
  948.         RETURN (0);
  949.     ENDIF;
  950.  
  951.     IF (token_1 = "update") THEN
  952.         vi$min_update := 0;
  953.         RETURN (0);
  954.     ENDIF;
  955.  
  956.     IF (token_1 = "noshowmode") OR (token_1 = "nosm") THEN
  957.         vi$show_mode := 0;
  958.         RETURN (0);
  959.     ENDIF;
  960.  
  961.     IF (token_1 = "showmode") OR (token_1 = "sm") THEN
  962.         vi$show_mode := 1;
  963.         RETURN (0);
  964.     ENDIF;
  965.  
  966.     IF (token_1 = "wrapmargin") OR (token_1 = "wm") THEN
  967.         token_2 := vi$skip_separ (cmd, i, "=    ", separ);
  968.         vi$wrap_margin := INT (token_2);
  969.         RETURN (0);
  970.     ENDIF;
  971.  
  972.     vi$para_str := "P p ";
  973.     vi$para_pat := line_begin & (
  974.                                     (".P" | ".p") |
  975.                                     (LINE_END));
  976.     IF (token_1 = "sections") OR (token_1 = "sect") THEN
  977.         pstr := "LINE_BEGIN&(";
  978.         use_fortran := 0;
  979.         vi$sect_str := "";
  980.         LOOP
  981.             EXITIF (SUBSTR (cmd, i, 1) = " ") OR (i >= LENGTH (cmd));
  982.             npat := SUBSTR (cmd, i, 2);
  983.             vi$sect_str := vi$sect_str + npat;
  984.             EDIT (npat, COLLAPSE);
  985.             IF (npat = "+c") OR (npat = "+C") THEN
  986.                 pstr := pstr + '"{"';
  987.             ELSE
  988.                 IF (npat = "+f") OR (npat = "+F") THEN
  989.                     use_fortran := 1;
  990.                     npat := "";
  991.                 ELSE
  992.                     IF (npat = "+t") OR (npat = "+T") THEN
  993.                         pstr := pstr + '"PROCEDURE"';
  994.                     ELSE
  995.                         pstr := pstr + '".' + npat + '"';
  996.                     ENDIF;
  997.                 ENDIF;
  998.             ENDIF;
  999.             i := i + 2;
  1000.             EXITIF (SUBSTR (cmd, i, 1) = " ") OR (i >= LENGTH (cmd));
  1001.             IF (npat <> "") THEN
  1002.                 pstr := pstr + "|";
  1003.             ENDIF;
  1004.         ENDLOOP;
  1005.         pstr := pstr + ")";
  1006.         IF (use_fortran) THEN
  1007.             pstr := '""&(("FUNCTION"|"SUBROUTINE")|('+ pstr + "))";
  1008.         ELSE
  1009.             pstr := '""&'+pstr;
  1010.         ENDIF;
  1011.         EXECUTE (COMPILE ("vi$sect_pat:="+pstr+";"));
  1012.         RETURN (0);
  1013.     ENDIF;
  1014.  
  1015.     IF (token_1 = "paragraphs") OR (token_1 = "para") THEN
  1016.         pstr := '""&LINE_BEGIN&(';
  1017.         vi$para_str := "";
  1018.         LOOP
  1019.             EXITIF (SUBSTR (cmd, i, 1) = " ") OR (i >= LENGTH (cmd));
  1020.             npat := SUBSTR (cmd, i, 2);
  1021.             vi$para_str := vi$para_str + npat;
  1022.             EDIT (npat, COLLAPSE);
  1023.             pstr := pstr + '".' + npat + '"';
  1024.             i := i + 2;
  1025.             EXITIF (SUBSTR (cmd, i, 1) = " ") OR (i >= LENGTH (cmd));
  1026.             IF (npat <> "") THEN
  1027.                 pstr := pstr + "|";
  1028.             ENDIF;
  1029.         ENDLOOP;
  1030.         pstr := pstr + ")";
  1031.         EXECUTE (COMPILE ("vi$para_pat:="+pstr+";"));
  1032.         RETURN (0);
  1033.     ENDIF;
  1034.  
  1035.     IF (token_1 = "number") OR
  1036.             (token_1 = "optimize") OR
  1037.             (token_1 = "autoindent") OR
  1038.             (token_1 = "noautoprint") OR
  1039.             (token_1 = "novice") OR
  1040.             (token_1 = "slowopen") OR
  1041.             (token_1 = "beautify") OR
  1042.             (token_1 = "taglength") OR
  1043.             (token_1 = "directory") OR
  1044.             (token_1 = "noprompt") OR
  1045.             (token_1 = "edcompatible") OR
  1046.             (token_1 = "term") OR
  1047.             (token_1 = "noredraw") OR
  1048.             (token_1 = "terse") OR
  1049.             (token_1 = "flash") OR
  1050.             (token_1 = "noremap") OR
  1051.             (token_1 = "timeout") OR
  1052.             (token_1 = "hardtabs") OR
  1053.             (token_1 = "ttytype") OR
  1054.             (token_1 = "warn") OR
  1055.             (token_1 = "nowarn") OR
  1056.             (token_1 = "lisp") OR
  1057.             (token_1 = "list") OR
  1058.             (token_1 = "shell") OR
  1059.             (token_1 = "mesg") OR
  1060.             (token_1 = "nomesg") OR
  1061.             (token_1 = "showmatch") THEN
  1062.         vi$not_implemented (token_1);
  1063.         RETURN (1);
  1064.     ENDIF;
  1065.  
  1066.     vi$message ("Unrecognized option, use `set all' to see options.");
  1067.     RETURN (1);
  1068.  
  1069. ENDPROCEDURE;
  1070.  
  1071. !
  1072. !   Set the window length to the integer value passed.
  1073. !
  1074. PROCEDURE vi$do_set_window (len)
  1075.     LOCAL
  1076.         buf,
  1077.         curwin,
  1078.         curbuf;
  1079.  
  1080.     curwin := CURRENT_WINDOW;
  1081.     curbuf := CURRENT_BUFFER;
  1082.  
  1083.     IF (vi$prev_win (curwin) = 0) AND (vi$next_win (curwin) = 0)
  1084.                                             AND (NOT vi$in_occlusion) THEN
  1085.         IF len < 3 THEN
  1086.             len := 3;
  1087.         ENDIF;
  1088.  
  1089.         IF len > GET_INFO (SCREEN, "VISIBLE_LENGTH") THEN
  1090.             len := GET_INFO (SCREEN, "VISIBLE_LENGTH");
  1091.         ENDIF;
  1092.  
  1093.         oldscrlen := vi$scr_length;
  1094.         vi$scr_length := len;
  1095.  
  1096.         ADJUST_WINDOW (curwin, 0, vi$scr_length - oldscrlen);
  1097.  
  1098.         buf := GET_INFO (message_window, "BUFFER");
  1099.         UNMAP (message_window);
  1100.         DELETE (message_window);
  1101.         message_window := CREATE_WINDOW (vi$scr_length - 1, 2, ON);
  1102.         MAP (message_window, buf);
  1103.         SET (STATUS_LINE, message_window, NONE, "");
  1104.         ADJUST_WINDOW (message_window, 1, 0);
  1105.  
  1106.         DELETE (command_window);
  1107.         command_window := CREATE_WINDOW (vi$scr_length, 1, OFF);
  1108.  
  1109.         buf := GET_INFO (info_window, "BUFFER");
  1110.         DELETE (info_window);
  1111.         info_window := CREATE_WINDOW (1, vi$scr_length - 1, ON);
  1112.         SET (STATUS_LINE, info_window, NONE, "");
  1113.  
  1114.         SET (PROMPT_AREA, vi$scr_length, 1, REVERSE);
  1115.  
  1116.         POSITION (curbuf);
  1117.         POSITION (curwin);
  1118.         UNMAP (curwin);
  1119.         MAP (curwin, curbuf);
  1120.     ELSE
  1121.         MESSAGE (
  1122.         "Can't change length of screen while multiple windows visible!");
  1123.         RETURN (1);
  1124.     ENDIF;
  1125.  
  1126.     vi$how_much_scroll := vi$scr_length / 2;
  1127.     RETURN (0);
  1128. ENDPROCEDURE;
  1129.  
  1130. !
  1131. !   Show the current settings when ":set all" is issued.
  1132. !
  1133. PROCEDURE vi$show_settings
  1134.     LOCAL
  1135.         obuf,
  1136.         ic,
  1137.         ostat,
  1138.         ovid,
  1139.         buf;
  1140.  
  1141.     buf := vi$init_buffer ("$$vi_set_all$$", "");
  1142.  
  1143.     ostat := GET_INFO (CURRENT_WINDOW, "STATUS_LINE");
  1144.     IF (ostat = 0) THEN
  1145.         ostat := "";
  1146.     ENDIF;
  1147.     ovid := GET_INFO (CURRENT_WINDOW, "STATUS_VIDEO");
  1148.     IF (ovid = 0) THEN
  1149.         ovid := NONE;
  1150.     ENDIF;
  1151.     SET (STATUS_LINE, CURRENT_WINDOW, NONE, "");
  1152.     SET (STATUS_LINE, CURRENT_WINDOW, REVERSE,
  1153.         "                      Current settings of VI options");
  1154.     SET (EOB_TEXT, buf,
  1155.                 "                      [Hit ENTER to continue editing]");
  1156.     obuf := CURRENT_BUFFER;
  1157.     POSITION (buf);
  1158.  
  1159.     IF vi$ignore_case = EXACT THEN
  1160.         ic := 2;
  1161.     ELSE
  1162.         ic := 0;
  1163.     ENDIF;
  1164.  
  1165.     COPY_TEXT (FAO (
  1166.     "!20<wrapmargin=!UL!>!20<tabstop=!UL!>!20<!ASmagic!>!20<!ASignorecase!>",
  1167.             vi$wrap_margin, vi$tab_amount,
  1168.             SUBSTR ("no", 1, (1-vi$magic)*2),
  1169.             SUBSTR ("no", 1, ic)));
  1170.  
  1171.     SPLIT_LINE;
  1172.  
  1173.     COPY_TEXT (FAO (
  1174.     "!20<shiftwidth=!UL!>!20<scroll=!UL!>!20<report=!UL!>!20<!ASautowrite!>",
  1175.             vi$shift_width, vi$how_much_scroll, vi$report,
  1176.             SUBSTR ("no", 1, (1-vi$auto_write)*2)));
  1177.  
  1178.     SPLIT_LINE;
  1179.  
  1180.     COPY_TEXT (FAO (
  1181.             "!20<!ASwrapscan!>!20<!ASupdate!>!20<!AStabs!>!20<!ASundomap!>",
  1182.             SUBSTR ("no", 1, (1-vi$wrap_scan)*2),
  1183.             SUBSTR ("no", 1, (vi$min_update)*2),
  1184.             SUBSTR ("no", 1, (1-vi$use_tabs)*2),
  1185.             SUBSTR ("no", 1, (1-vi$undo_map)*2)
  1186.         ));
  1187.  
  1188.     SPLIT_LINE;
  1189.  
  1190.     IF vi$tag_case = EXACT THEN
  1191.         ic := 0;
  1192.     ELSE
  1193.         ic := 2;
  1194.     ENDIF;
  1195.  
  1196.     COPY_TEXT (FAO (
  1197.             "!20<!AStagcase!>!20<window=!UL!>!20<width=!UL!>tags=!AS",
  1198.             SUBSTR ("no", 1, ic),
  1199.             GET_INFO (CURRENT_WINDOW, "VISIBLE_LENGTH"),
  1200.             GET_INFO (CURRENT_WINDOW, "WIDTH"),
  1201.             vi$tag_files
  1202.         ));
  1203.  
  1204.     SPLIT_LINE;
  1205.  
  1206.     COPY_TEXT (FAO (
  1207.             "!20<!ASerrorbells!>!20<paragraphs=!AS!>!20<sections=!AS!>"+
  1208.                 "!20<!ASsenddcl!>",
  1209.             SUBSTR ("no", 1, (1-vi$error_bells)*2),
  1210.             vi$para_str,
  1211.             vi$sect_str,
  1212.             SUBSTR ("no", 1, (1-vi$send_dcl)*2)
  1213.         ));
  1214.  
  1215.     SPLIT_LINE;
  1216.  
  1217.     COPY_TEXT (FAO (
  1218.             "!20<!ASshowmode!>",
  1219.             SUBSTR ("no", 1, (1-vi$show_mode)*2)
  1220.         ));
  1221.  
  1222.     SPLIT_LINE;
  1223.  
  1224.     MAP (CURRENT_WINDOW, buf);
  1225.     UPDATE (CURRENT_WINDOW);
  1226.     LOOP
  1227.         EXITIF vi$read_a_key = RET_KEY;
  1228.     ENDLOOP;
  1229.  
  1230.     SET (STATUS_LINE, CURRENT_WINDOW, NONE, "");
  1231.     SET (STATUS_LINE, CURRENT_WINDOW, ovid, ostat);
  1232.     MAP (CURRENT_WINDOW, obuf);
  1233.     POSITION (obuf);
  1234.     DELETE (buf);
  1235. ENDPROCEDURE;
  1236.  
  1237. !
  1238. !   Function to say that a particular command is not implemented.
  1239. !
  1240. PROCEDURE vi$not_implemented (cmd)
  1241.     vi$message (cmd + " is not implemented!");
  1242. ENDPROCEDURE;
  1243.  
  1244. !
  1245. !   The function mapped to 't'.
  1246. !
  1247. PROCEDURE vi$_to_char (char_to_find)
  1248.     LOCAL
  1249.         char_val;
  1250.  
  1251.     char_val := char_to_find;
  1252.     vi$position (vi$to_char (char_val), 0);
  1253. ENDPROCEDURE;
  1254.  
  1255. !
  1256. !   Function performing task for 't'.
  1257. !
  1258. PROCEDURE vi$to_char (char_to_find)
  1259.  
  1260.     LOCAL
  1261.         act_count,
  1262.         pos,
  1263.         found;
  1264.  
  1265.     IF char_to_find = 0 THEN
  1266.         char_to_find := vi$read_char_to_find;
  1267.     ENDIF;
  1268.  
  1269.     vi$last_s_char := char_to_find;
  1270.     vi$last_s_func := "vi$to_char";
  1271.  
  1272.     pos := MARK(NONE);
  1273.  
  1274.     act_count := vi$cur_active_count;
  1275.  
  1276.     MOVE_HORIZONTAL (1);
  1277.  
  1278.     IF char_to_find <> ASCII(27) THEN
  1279.         found := 0;
  1280.         LOOP
  1281.             EXITIF (CURRENT_OFFSET >= LENGTH (vi$current_line));
  1282.             MOVE_HORIZONTAL (1);
  1283.             found := 1;
  1284.             IF (CURRENT_CHARACTER = char_to_find) THEN
  1285.                 act_count := act_count - 1;
  1286.                 EXITIF (act_count = 0);
  1287.             ENDIF;
  1288.             found := 0;
  1289.         ENDLOOP;
  1290.  
  1291.         IF (NOT found) THEN
  1292.             POSITION (pos);
  1293.             RETURN (0);
  1294.         ELSE
  1295.             vi$move_horizontal (-1);
  1296.         ENDIF;
  1297.     ENDIF;
  1298.  
  1299.     vi$yank_mode := VI$IN_LINE_MODE;
  1300.     RETURN (vi$retpos (pos));
  1301.  
  1302. ENDPROCEDURE;
  1303.  
  1304. !
  1305. !   The function mapped to 'T'.
  1306. !
  1307. PROCEDURE vi$_back_to_char (char_to_find)
  1308.  
  1309.     LOCAL
  1310.         char_val;
  1311.  
  1312.     char_val := char_to_find;
  1313.     vi$position (vi$back_to_char (char_val), 0);
  1314. ENDPROCEDURE;
  1315.  
  1316. !
  1317. !   Function performing task for 'T'.
  1318. !
  1319. PROCEDURE vi$back_to_char (char_to_find)
  1320.  
  1321.     LOCAL
  1322.         act_count,
  1323.         pos,
  1324.         found;
  1325.  
  1326.     IF char_to_find = 0 THEN
  1327.         char_to_find := vi$read_char_to_find;
  1328.     ENDIF;
  1329.  
  1330.     vi$last_s_char := char_to_find;
  1331.     vi$last_s_func := "vi$back_to_char";
  1332.  
  1333.     pos := MARK(NONE);
  1334.  
  1335.     IF (CURRENT_OFFSET = 0) THEN
  1336.         RETURN (0);
  1337.     ENDIF;
  1338.  
  1339.     vi$move_horizontal (-1);
  1340.     IF (CURRENT_CHARACTER <> char_to_find) THEN
  1341.         vi$move_horizontal (1);
  1342.     ENDIF;
  1343.  
  1344.     act_count := vi$cur_active_count;
  1345.  
  1346.     IF char_to_find <> ASCII(27) THEN
  1347.         found := 0;
  1348.         LOOP
  1349.             EXITIF (CURRENT_OFFSET = 0);
  1350.             vi$move_horizontal (-1);
  1351.             found := 1;
  1352.             IF (CURRENT_CHARACTER = char_to_find) THEN
  1353.                 act_count := act_count - 1;
  1354.                 EXITIF (act_count = 0);
  1355.             ENDIF;
  1356.             found := 0;
  1357.         ENDLOOP;
  1358.  
  1359.         IF (NOT found) THEN
  1360.             POSITION (pos);
  1361.             RETURN (0);
  1362.         ELSE
  1363.             MOVE_HORIZONTAL(1);
  1364.         ENDIF;
  1365.     ENDIF;
  1366.  
  1367.     vi$yank_mode := VI$IN_LINE_MODE;
  1368.     RETURN (vi$retpos (pos));
  1369. ENDPROCEDURE;
  1370.  
  1371. !
  1372. !   The function mapped to 'f'.
  1373. !
  1374. PROCEDURE vi$_find_char (char_to_find)
  1375.  
  1376.     LOCAL
  1377.         char_val;
  1378.  
  1379.     char_val := char_to_find;
  1380.     vi$position (vi$find_char (char_val), 0);
  1381. ENDPROCEDURE;
  1382.  
  1383. !
  1384. !   Function performing task for 'f'.
  1385. !
  1386. PROCEDURE vi$find_char (char_to_find)
  1387.  
  1388.     LOCAL
  1389.         act_count,
  1390.         pos,
  1391.         found;
  1392.  
  1393.     IF char_to_find = 0 THEN
  1394.         char_to_find := vi$read_char_to_find;
  1395.     ENDIF;
  1396.  
  1397.     vi$last_s_char := char_to_find;
  1398.     vi$last_s_func := "vi$find_char";
  1399.  
  1400.     act_count := vi$cur_active_count;
  1401.  
  1402.     IF char_to_find <> ASCII(27) THEN
  1403.         pos := MARK(NONE);
  1404.         found := 0;
  1405.         LOOP
  1406.             EXITIF (CURRENT_OFFSET >= LENGTH (vi$current_line));
  1407.             MOVE_HORIZONTAL (1);
  1408.             found := 1;
  1409.             IF (CURRENT_CHARACTER = char_to_find) THEN
  1410.                 act_count := act_count - 1;
  1411.                 EXITIF (act_count = 0);
  1412.             ENDIF;
  1413.             found := 0;
  1414.         ENDLOOP;
  1415.  
  1416.         IF (NOT found) THEN
  1417.             POSITION (pos);
  1418.             RETURN (0);
  1419.         ENDIF;
  1420.     ELSE
  1421.         RETURN (0);
  1422.     ENDIF;
  1423.  
  1424.     vi$yank_mode := VI$IN_LINE_MODE;
  1425.     RETURN (vi$retpos(pos));
  1426. ENDPROCEDURE;
  1427.  
  1428. !
  1429. !   The function mapped to 'F'.
  1430. !
  1431. PROCEDURE vi$_back_find_char (char_to_find)
  1432.  
  1433.     LOCAL
  1434.         char_val;
  1435.  
  1436.     char_val := char_to_find;
  1437.     vi$position (vi$back_find_char (char_val), 0);
  1438. ENDPROCEDURE;
  1439.  
  1440. !
  1441. !   Function performing task for 'F'.
  1442. !
  1443. PROCEDURE vi$back_find_char (char_to_find)
  1444.  
  1445.     LOCAL
  1446.         act_count,
  1447.         pos,
  1448.         found;
  1449.  
  1450.     IF char_to_find = 0 THEN
  1451.         char_to_find := vi$read_char_to_find;
  1452.     ENDIF;
  1453.  
  1454.     vi$last_s_char := char_to_find;
  1455.     vi$last_s_func := "vi$back_find_char";
  1456.  
  1457.     act_count := vi$cur_active_count;
  1458.  
  1459.     IF char_to_find <> ASCII(27) THEN
  1460.         pos := MARK(NONE);
  1461.  
  1462.         LOOP
  1463.             found := 0;
  1464.             EXITIF CURRENT_OFFSET = 0;
  1465.             vi$move_horizontal (-1);
  1466.             found := 1;
  1467.             IF (CURRENT_CHARACTER = char_to_find) THEN
  1468.                 act_count := act_count - 1;
  1469.                 EXITIF act_count = 0;
  1470.             ENDIF;
  1471.         ENDLOOP;
  1472.  
  1473.         IF (NOT found) THEN
  1474.             POSITION (pos);
  1475.             RETURN (0);
  1476.         ENDIF;
  1477.     ENDIF;
  1478.  
  1479.     vi$yank_mode := VI$IN_LINE_MODE;
  1480.     RETURN (vi$retpos (pos));
  1481. ENDPROCEDURE;
  1482.  
  1483. !
  1484. !   Function to read a key, and change TAB_KEY to ASCII (9).  Currently
  1485. !   used by f, F, t and T commands only.
  1486. !
  1487. PROCEDURE vi$read_char_to_find
  1488.     LOCAL
  1489.         rkey;
  1490.  
  1491.     rkey := vi$read_a_key;
  1492.     IF (rkey = TAB_KEY) THEN
  1493.         RETURN (ASCII (9));
  1494.     ELSE
  1495.         IF (rkey = RET_KEY) THEN
  1496.             RETURN (ASCII (13));
  1497.         ELSE
  1498.             IF (rkey = DEL_KEY) THEN
  1499.                 RETURN (ASCII (8));
  1500.             ENDIF;
  1501.         ENDIF;
  1502.     ENDIF;
  1503.     RETURN (ASCII (rkey));
  1504. ENDPROCEDURE;
  1505. !
  1506. !   The function mapped to 'G'.
  1507. !
  1508. PROCEDURE vi$go_to_line
  1509.     vi$position (vi$to_line (vi$active_count), 1);
  1510.     vi$pos_in_middle (MARK (NONE));
  1511.  
  1512. $$EOD$$
  1513.