home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume1 / 8710 / vms-vi / 11 < prev    next >
Encoding:
Internet Message Format  |  1990-07-13  |  36.5 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 11/13
  5. Message-ID: <4860@ncoast.UUCP>
  6. Date: 13 Oct 87 02:55:24 GMT
  7. Sender: allbery@ncoast.UUCP
  8. Organization: Oklahoma State Univ., Stillwater
  9. Lines: 1502
  10. Approved: allbery@ncoast.UUCP
  11. X-Archive: comp.sources.misc/8710/vms-vi/11
  12.  
  13. $ WRITE SYS$OUTPUT "Creating ""VI.10"""
  14. $ CREATE VI.10
  15. $ DECK/DOLLARS=$$EOD$$
  16.     IF (direction = -1) THEN
  17.         LOOP
  18.             EXITIF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER));
  19.             MOVE_HORIZONTAL (-1);
  20.             EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE);
  21.         ENDLOOP;
  22.     ENDIF;
  23.  
  24.     LOOP
  25.         EXITIF ((MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) AND
  26.                 (direction = -1));
  27.         EXITIF ((MARK (NONE) = END_OF (CURRENT_BUFFER)) AND
  28.                 (direction = 1));
  29.         EXITIF (CURRENT_CHARACTER = "");
  30.         EXITIF vi$get_type (CURRENT_CHARACTER) = VI$SPACE_TYPE;
  31.         MOVE_HORIZONTAL (direction);
  32.     ENDLOOP;
  33.  
  34.     ! A hack to make change work like it is supposed to with "cw".
  35.  
  36.     IF (vi$command_type = VI$CHANGE_TYPE) AND (direction = 1) THEN
  37.         vi$new_endpos := MARK (NONE);
  38.     ENDIF;
  39.  
  40.     IF (direction = 1) THEN
  41.         LOOP
  42.             EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
  43.             EXITIF (CURRENT_CHARACTER = "");
  44.             MOVE_HORIZONTAL (1);
  45.             EXITIF vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE;
  46.         ENDLOOP;
  47.     ELSE
  48.         IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
  49.             MOVE_HORIZONTAL (1);
  50.         ENDIF;
  51.     ENDIF;
  52.  
  53.     RETURN (vi$retpos(pos));
  54. ENDPROCEDURE;
  55.  
  56. !
  57. !   Move the cursor by logical words.  Note that words in this case are
  58. !   delimited by a change from one type of character to another.  The
  59. !   predefined types
  60. !
  61. !       VI$ALPHA_TYPE, VI$PUNCT_TYPE, and VI$SPACE_TYPE
  62. !
  63. !   are used to detect transitions from one word to the next;
  64. !
  65. PROCEDURE vi$move_logical_word (direction)
  66.  
  67.     LOCAL
  68.         this_type,
  69.         this_char,
  70.         pos;
  71.  
  72.     pos := MARK (NONE);
  73.  
  74.     !   If direction is back, then skip SPACE characters until no space
  75.     !   is found.
  76.  
  77.     IF (direction = -1) THEN
  78.         LOOP
  79.             EXITIF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER));
  80.             MOVE_HORIZONTAL (-1);
  81.             EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE);
  82.         ENDLOOP;
  83.     ENDIF;
  84.  
  85.     this_char := CURRENT_CHARACTER;
  86.     this_type := vi$get_type (this_char);
  87.  
  88.     LOOP
  89.         EXITIF ((MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) AND
  90.                 (direction = -1));
  91.  
  92.         EXITIF ((MARK (NONE) = END_OF (CURRENT_BUFFER)) AND
  93.                 (direction = 1));
  94.  
  95.         MOVE_HORIZONTAL (direction);
  96.         EXITIF (vi$get_type (CURRENT_CHARACTER) <> this_type);
  97.     ENDLOOP;
  98.  
  99.     ! A hack to make change work like it is supposed to with "cw".
  100.  
  101.     IF (vi$command_type = VI$CHANGE_TYPE) AND (direction = 1) THEN
  102.         vi$new_endpos := MARK (NONE);
  103.     ENDIF;
  104.  
  105.     IF (direction = 1) THEN
  106.         LOOP
  107.             EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE);
  108.             MOVE_HORIZONTAL (1);
  109.             EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
  110.         ENDLOOP;
  111.     ELSE
  112.         IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
  113.             MOVE_HORIZONTAL (1);
  114.         ENDIF;
  115.     ENDIF;
  116.  
  117.     RETURN (vi$retpos (pos));
  118.  
  119. ENDPROCEDURE;
  120.  
  121. !
  122. !   Move the cursor by BLANK separated words.  DIRECTION is either
  123. !   +1, or -1 to indicate the direction (forward, or backword respectfully)
  124. !   to move
  125. !
  126. PROCEDURE vi$move_full_end
  127.  
  128.     LOCAL
  129.         pos;
  130.  
  131.     pos := MARK (NONE);
  132.  
  133.     MOVE_HORIZONTAL (1);
  134.     LOOP
  135.         EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
  136.         EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE);
  137.         MOVE_HORIZONTAL (1);
  138.     ENDLOOP;
  139.  
  140.     LOOP
  141.         EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
  142.         EXITIF (vi$get_type (CURRENT_CHARACTER) = VI$SPACE_TYPE);
  143.         MOVE_HORIZONTAL (1);
  144.     ENDLOOP;
  145.  
  146.     MOVE_HORIZONTAL (-1);
  147.     RETURN (vi$retpos(pos));
  148. ENDPROCEDURE;
  149.  
  150. !
  151. !   Move the cursor by logical words.  Note that words in this case are
  152. !   delimited by a change from one type of character to another.  The
  153. !   predefined types
  154. !
  155. !       VI$ALPHA_TYPE, VI$PUNCT_TYPE, and VI$SPACE_TYPE
  156. !
  157. !   are used to detect transitions from one word to the next;
  158. !
  159. PROCEDURE vi$move_logical_end
  160.  
  161.     LOCAL
  162.         this_type,
  163.         this_char,
  164.         pos;
  165.  
  166.     pos := MARK (NONE);
  167.  
  168.     MOVE_HORIZONTAL (1);
  169.     LOOP
  170.         EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
  171.         EXITIF (vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE);
  172.         MOVE_HORIZONTAL (1);
  173.     ENDLOOP;
  174.  
  175.     this_char := CURRENT_CHARACTER;
  176.     this_type := vi$get_type (this_char);
  177.  
  178.     LOOP
  179.         EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
  180.         EXITIF (vi$get_type (CURRENT_CHARACTER) <> this_type);
  181.         MOVE_HORIZONTAL (1);
  182.     ENDLOOP;
  183.  
  184.     MOVE_HORIZONTAL (-1);
  185.     RETURN (vi$retpos (pos));
  186. ENDPROCEDURE;
  187.  
  188. !
  189. !   Return the logical type of the character passed.  This is typically used
  190. !   by the move_by_word routines to determine when a word ends.
  191. !
  192. PROCEDURE vi$get_type (this_char)
  193.  
  194.     LOCAL
  195.         this_type;
  196.  
  197.     IF (this_char = "") THEN
  198.         RETURN (VI$EOL_TYPE);
  199.     ENDIF;
  200.  
  201.     this_type := VI$SPACE_TYPE;
  202.  
  203.     IF (INDEX (vi$_alpha_chars, this_char) <> 0) THEN
  204.         this_type := VI$ALPHA_TYPE;
  205.     ELSE
  206.         IF (INDEX (vi$_punct_chars, this_char) <> 0) THEN
  207.             this_type := VI$PUNCT_TYPE;
  208.         ENDIF;
  209.     ENDIF;
  210.  
  211.     RETURN (this_type);
  212. ENDPROCEDURE;
  213.  
  214. !
  215. !   This procedure determines what line the cursor is currently positioned
  216. !   on. and then prints that information, along with other items of interest
  217. !   in the message window.
  218. !
  219. PROCEDURE vi$what_line
  220.  
  221.     LOCAL
  222.         percent,
  223.         mod,
  224.         outfile,
  225.         lines,
  226.         nowr,
  227.         pos,
  228.         cnt;
  229.  
  230.     ON_ERROR;
  231.         lines := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
  232.         IF (cnt) > lines THEN
  233.             cnt := lines;
  234.         ENDIF;
  235.  
  236.         IF lines = 0 THEN
  237.             percent := 0;
  238.         ELSE
  239.             percent := (cnt*100)/lines;
  240.         ENDIF;
  241.  
  242.         vi$message (FAO ("!ASLine !UL of !UL, !UL%, !AS!AS",
  243.                                     nowr, cnt, lines, percent, mod, outfile));
  244.  
  245.         SET (TIMER, OFF);
  246.         RETURN;
  247.     ENDON_ERROR;
  248.  
  249.     nowr := " ";
  250.     IF (GET_INFO (CURRENT_BUFFER, "NO_WRITE")) THEN
  251.         nowr := "*";
  252.     ENDIF;
  253.  
  254.     mod := "";
  255.     IF GET_INFO (CURRENT_BUFFER, "MODIFIED") THEN
  256.         mod := "[modified] ";
  257.     ENDIF;
  258.  
  259.     pos := MARK(NONE);
  260.     MOVE_HORIZONTAL (- CURRENT_OFFSET);
  261.  
  262.     cnt := 0;
  263.     lines := 0;
  264.     outfile := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE");
  265.     IF (outfile = 0) THEN
  266.         outfile := "Not Edited";
  267.     ELSE
  268.         outfile := """"+outfile+"""";
  269.     ENDIF;
  270.  
  271.     cnt := vi$cur_line_no;
  272.  
  273.     POSITION (pos);
  274.  
  275.     lines := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
  276.     IF (cnt) > lines THEN
  277.         cnt := lines;
  278.     ENDIF;
  279.  
  280.     IF lines = 0 THEN
  281.         percent := 0;
  282.     ELSE
  283.         percent := (cnt*100)/lines;
  284.     ENDIF;
  285.  
  286.     vi$message (FAO ("!ASLine !UL of !UL, !UL%, !AS!AS",
  287.                                     nowr, cnt, lines, percent, mod, outfile));
  288.     SET (TIMER, OFF);
  289. ENDPROCEDURE;
  290.  
  291. !
  292. !   This function moves to "pos" if it is non-zero.  If "pos" is zero, then
  293. !   any current macro is aborted, and the current position is not changed.
  294. !   "save_pos" is a boolean value that indicates whether or not the current
  295. !   location is remembered so that it can be returned to later with the
  296. !   "'" (go to marker) command.
  297. !
  298. PROCEDURE vi$position (pos, save_pos)
  299.     IF (pos <> 0) THEN
  300.         IF save_pos THEN
  301.             vi$old_place := MARK (NONE);
  302.         ENDIF;
  303.         POSITION (pos);
  304.     ELSE
  305.         RETURN (vi$abort (0));
  306.     ENDIF;
  307.     RETURN (pos);
  308. ENDPROCEDURE;
  309.  
  310. !
  311. !   This function implements the command mode function of joining the
  312. !   current line with the one below it.
  313. !
  314. !   The undo operation consists of deleting the line created by joining
  315. !   the two lines, and then inserting the original contents of the two
  316. !   joined lines.
  317. !
  318. PROCEDURE vi$_join_lines
  319.  
  320.     LOCAL
  321.         start,
  322.         end,
  323.         spos,
  324.         epos,
  325.         pos,
  326.         plen,
  327.         len;
  328.  
  329.     ON_ERROR
  330.         !  Throw away moved beyond end of buffer messages.
  331.         RETURN;
  332.     ENDON_ERROR;
  333.  
  334.     spos := MARK (NONE);
  335.     MOVE_HORIZONTAL (-CURRENT_OFFSET);
  336.     pos := MARK (NONE);
  337.     IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
  338.         MOVE_VERTICAL (1);
  339.         IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
  340.             MOVE_VERTICAL (1);
  341.             MOVE_HORIZONTAL (-1);
  342.             epos := MARK (NONE);
  343.             POSITION (spos);
  344.             vi$save_for_undo (CREATE_RANGE (pos, epos, NONE),
  345.                                                             VI$LINE_MODE, 1);
  346.             POSITION (pos);
  347.         ELSE
  348.             RETURN;
  349.         ENDIF;
  350.     ELSE
  351.         RETURN;
  352.     ENDIF;
  353.  
  354.     MOVE_HORIZONTAL (LENGTH (vi$current_line));
  355.  
  356.     LOOP
  357.         EXITIF (CURRENT_OFFSET = 0);
  358.         MOVE_HORIZONTAL (-1);
  359.         EXITIF INDEX ("     ", CURRENT_CHARACTER) = 0;
  360.         ERASE_CHARACTER (1);
  361.     ENDLOOP;
  362.  
  363.     plen := LENGTH (vi$current_line);
  364.     vi$_next_line;
  365.  
  366.     IF (CURRENT_OFFSET > 0) AND (plen > 0) THEN
  367.         ERASE_CHARACTER (-CURRENT_OFFSET);
  368.     ENDIF;
  369.  
  370.     len := LENGTH (vi$current_line);
  371.     APPEND_LINE;
  372.  
  373.     IF (len > 0) AND (plen > 0) THEN
  374.         COPY_TEXT (" ");
  375.         MOVE_HORIZONTAL (-1);
  376.     ELSE
  377.         vi$check_rmarg;
  378.     ENDIF;
  379.  
  380.     pos := MARK (NONE);
  381.  
  382.     MOVE_HORIZONTAL (-CURRENT_OFFSET);
  383.     vi$undo_start := MARK (NONE);
  384.     MOVE_HORIZONTAL (LENGTH (vi$current_line));
  385.     vi$undo_end := MARK (NONE);
  386.  
  387.     POSITION (pos);
  388. ENDPROCEDURE;
  389.  
  390. !
  391. !   This function filters the selected region through the command
  392. !   given.
  393. !
  394. PROCEDURE vi$region_filter
  395.  
  396.     LOCAL
  397.         era_range,
  398.         prog,
  399.         nchar,
  400.         copy_line,
  401.         orig_pos,
  402.         last_pos,
  403.         pos,
  404.         exitnow,
  405.         olen,
  406.         this_pos,
  407.         cur_tabs;
  408.  
  409.     vi$message ("");
  410.  
  411.     vi$start_pos := MARK (NONE);
  412.     pos := MARK (NONE);
  413.     nchar := vi$init_action (olen);
  414.     prog := vi$get_prog (nchar);
  415.  
  416.     IF prog <> "" THEN
  417.         vi$do_movement (prog, VI$FILTER_TYPE);
  418.  
  419.         IF (vi$endpos <> 0) THEN
  420.             POSITION (vi$endpos);
  421.             MOVE_HORIZONTAL (-CURRENT_OFFSET);
  422.             vi$endpos := MARK (NONE);
  423.             POSITION (vi$start_pos);
  424.             MOVE_HORIZONTAL (-CURRENT_OFFSET);
  425.  
  426.             IF (MARK (NONE) = vi$endpos) THEN
  427.                 MOVE_VERTICAL (1);
  428.                 vi$endpos := MARK (NONE);
  429.             ENDIF;
  430.  
  431.             POSITION (vi$endpos);
  432.  
  433.             vi$move_horizontal (-1);
  434.             era_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);
  435.             MOVE_HORIZONTAL (1);
  436.  
  437.             IF (era_range <> 0) THEN
  438.                 vi$undo_end := 0;
  439.                 POSITION (vi$start_pos);
  440.                 vi$save_for_undo (era_range, VI$LINE_MODE, 1);
  441.  
  442.                 POSITION (vi$start_pos);
  443.                 MOVE_HORIZONTAL (- CURRENT_OFFSET);
  444.  
  445.                 orig_pos := vi$get_undo_start;
  446.  
  447.                 IF (vi$filter_region (era_range, 0) = 0) THEN
  448.                     vi$kill_undo;
  449.                     vi$undo_end := 0;
  450.                     POSITION (pos);
  451.                     RETURN (vi$abort (0));
  452.                 ENDIF;
  453.  
  454.                 IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
  455.                     MOVE_HORIZONTAL (-1);
  456.                 ENDIF;
  457.  
  458.                 vi$undo_end := MARK (NONE);
  459.  
  460.                 vi$undo_start := vi$set_undo_start (orig_pos);
  461.                 vi$check_length (olen);
  462.             ELSE
  463.                 vi$message ("Internal error while filtering!");
  464.             ENDIF;
  465.         ELSE
  466.             vi$abort (0);
  467.         ENDIF;
  468.     ELSE
  469.         vi$abort (0);
  470.     ENDIF;
  471.  
  472. ENDPROCEDURE;
  473.  
  474. !
  475. !   Filter the region of text indicated by "region", using the command
  476. !   given in cmd_parm.
  477. !
  478. PROCEDURE vi$filter_region (region, cmd_parm)
  479.     LOCAL
  480.         cmd;
  481.  
  482.     ON_ERROR
  483.         vi$message ("ERROR filtering text!");
  484.         RETURN (0);
  485.     ENDON_ERROR;
  486.  
  487.     cmd := cmd_parm;
  488.  
  489.     IF (vi$filter_buf = 0) THEN
  490.         vi$filter_buf := vi$init_buffer ("$$filter_buffer$$", "");
  491.         IF (vi$filter_buf = 0) THEN
  492.             vi$message ("Can't create buffer, filter aborted!");
  493.             RETURN (0);
  494.         ENDIF;
  495.     ELSE
  496.         ERASE (vi$filter_buf);
  497.     ENDIF;
  498.  
  499.     IF (cmd = 0) THEN
  500.         IF (vi$read_a_line ("!", cmd) = 0) THEN
  501.             RETURN (0);
  502.         ENDIF;
  503.     ENDIF;
  504.  
  505.     vi$info_success_off;
  506.     IF (vi$filter_proc = 0) THEN
  507.         IF cmd = "!" THEN
  508.             cmd := vi$last_filter;
  509.             IF (cmd = 0) THEN
  510.                 MESSAGE ("No previous command to use!");
  511.                 RETURN (0);
  512.             ENDIF;
  513.         ELSE
  514.             vi$last_filter := cmd;
  515.         ENDIF;
  516.  
  517.         vi$filter_proc := CREATE_PROCESS (vi$filter_buf, cmd);
  518.  
  519.         IF (vi$filter_proc = 0) THEN
  520.             vi$message ("Can't create process, filter aborted!");
  521.             RETURN (0);
  522.         ENDIF;
  523.     ENDIF;
  524.  
  525.     SEND (region, vi$filter_proc);
  526.     IF vi$filter_proc <> 0 THEN
  527.         DELETE (vi$filter_proc);
  528.         vi$filter_proc := 0;
  529.     ENDIF;
  530.  
  531.     vi$info_success_on;
  532.  
  533.     ERASE (region);
  534.     COPY_TEXT (vi$filter_buf);
  535.     RETURN (1);
  536. ENDPROCEDURE;
  537.  
  538. !
  539. !   Shift the selected text region one SHIFT_WIDTH to the right.
  540. !
  541. PROCEDURE vi$region_right
  542.     vi$region_shift(1);
  543. ENDPROCEDURE
  544.  
  545. !
  546. !   Shift the selected text region one SHIFT_WIDTH to the left.
  547. !
  548. PROCEDURE vi$region_left
  549.     vi$region_shift (0);
  550. ENDPROCEDURE
  551.  
  552. !
  553. !   This function shifts the selected region right or left based on
  554. !   the mode passed.
  555. !
  556. !   Parameters:
  557. !       mode            0 indicates a left shift, 1 indicates right.
  558. !
  559. PROCEDURE vi$region_shift (mode)
  560.  
  561.     LOCAL
  562.         act_char,
  563.         needed,
  564.         era_range,
  565.         prog,
  566.         nchar,
  567.         copy_line,
  568.         tab_len,
  569.         oline,
  570.         nline,
  571.         state,
  572.         orig_pos,
  573.         last_pos,
  574.         exitnow,
  575.         this_pos,
  576.         cur_tabs;
  577.  
  578.     ON_ERROR;
  579.         IF state <> 0 THEN
  580.             IF (ERROR = TPU$_ENDOFBUF) AND (state := 2) THEN
  581.                 exitnow := 1;
  582.             ELSE
  583.                 orig_pos := 0;
  584.             ENDIF;
  585.         ELSE
  586.             vi$message ("Error occured during shift, at line: "+
  587.                                                         STR(ERROR_LINE));
  588.             POSITION (vi$start_pos);
  589.             RETURN;
  590.         ENDIF;
  591.     ENDON_ERROR;
  592.  
  593.     vi$message ("");
  594.  
  595.     vi$start_pos := MARK (NONE);
  596.     nchar := vi$init_action (state);
  597.     state := 0;
  598.  
  599.     IF ((mode = 1) AND (ASCII (nchar) = '<')) OR
  600.                                     ((mode = 0) AND (ASCII (nchar) = '>')) THEN
  601.         RETURN;
  602.     ENDIF;
  603.  
  604.     prog := vi$get_prog (nchar);
  605.  
  606.     IF prog <> "" THEN
  607.         vi$do_movement (prog, VI$SHIFT_TYPE);
  608.  
  609.         oline := vi$cur_line_no;
  610.         IF (vi$endpos <> 0) THEN
  611.             POSITION (vi$endpos);
  612.             MOVE_HORIZONTAL (-CURRENT_OFFSET);
  613.             nline := vi$abs (vi$cur_line_no - oline);
  614.             vi$endpos := MARK (NONE);
  615.             POSITION (vi$start_pos);
  616.             MOVE_HORIZONTAL (-CURRENT_OFFSET);
  617.  
  618.             IF (MARK (NONE) = vi$endpos) THEN
  619.                 MOVE_VERTICAL (1);
  620.                 vi$endpos := MARK (NONE);
  621.             ENDIF;
  622.  
  623.             POSITION (vi$endpos);
  624.  
  625.             vi$move_horizontal (-1);
  626.             era_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);
  627.             MOVE_HORIZONTAL (1);
  628.  
  629.             IF (era_range <> 0) THEN
  630.                 vi$undo_end := 0;
  631.                 POSITION (vi$start_pos);
  632.                 vi$save_for_undo (era_range, vi$yank_mode, 1);
  633.  
  634.                 POSITION (vi$start_pos);
  635.                 MOVE_HORIZONTAL (- CURRENT_OFFSET);
  636.  
  637.                 orig_pos := vi$get_undo_start;
  638.  
  639.                 cur_tabs := GET_INFO (CURRENT_BUFFER, "TAB_STOPS");
  640.  
  641.                 IF (GET_INFO (cur_tabs, "TYPE") = STRING) THEN
  642.                     vi$message ("Can't shift region with uneven tabstops.");
  643.                     RETURN;
  644.                 ELSE
  645.                     tab_len := cur_tabs;
  646.                 ENDIF;
  647.  
  648.                 state := 2;
  649.                 exitnow := 0;
  650.  
  651.                 LOOP
  652.                     EXITIF MARK (NONE) = vi$endpos;
  653.                     EXITIF MARK (NONE) = END_OF (CURRENT_BUFFER);
  654.                     EXITIF (exitnow = 1);
  655.  
  656.                     copy_line := vi$current_line;
  657.  
  658.                     IF (copy_line <> "") THEN
  659.  
  660.                         ! Copy line is truncated to have no leading spaces.
  661.  
  662.                         needed := vi$vis_indent (copy_line, tab_len);
  663.  
  664.                         IF mode = 1 THEN
  665.                             needed := needed + vi$shift_width;
  666.                         ELSE
  667.                             needed := needed - vi$shift_width;
  668.                         ENDIF;
  669.  
  670.                         IF (needed < 0) THEN
  671.                             needed := 0;
  672.                         ENDIF;
  673.  
  674.                         ERASE_LINE;
  675.                         COPY_TEXT (vi$get_tabs (needed, tab_len)+copy_line);
  676.  
  677.                         MOVE_HORIZONTAL (1);
  678.                         IF (MARK (NONE) <> END_OF(CURRENT_BUFFER)) THEN
  679.                             MOVE_HORIZONTAL (-1);
  680.                             SPLIT_LINE;
  681.                         ENDIF;
  682.                     ELSE
  683.                         MOVE_VERTICAL (1);
  684.                     ENDIF;
  685.                     MOVE_HORIZONTAL (- CURRENT_OFFSET);
  686.                 ENDLOOP;
  687.  
  688.                 MOVE_HORIZONTAL (-1);
  689.                 vi$undo_end := MARK (NONE);
  690.  
  691.                 vi$undo_start := vi$set_undo_start (orig_pos);
  692.                 POSITION (vi$undo_start);
  693.                 IF (nline >= vi$report) THEN
  694.                     act_char := ">";
  695.                     IF mode = 0 THEN
  696.                         act_char := "<";
  697.                     ENDIF;
  698.                     vi$message (STR (nline) + " lines " + act_char + "'d");
  699.                 ENDIF;
  700.             ELSE
  701.                 vi$message ("Internal error while shifting!");
  702.             ENDIF;
  703.         ELSE
  704.             vi$abort (0);
  705.         ENDIF;
  706.     ELSE
  707.         vi$abort (0);
  708.     ENDIF;
  709.  
  710. ENDPROCEDURE;
  711.  
  712. !
  713. !  This procedure is called by REGION_SHIFT to calculate the number of spaces
  714. !  occupied on the screen by the leading white space of "line".  "tabstops"
  715. !  holds the number of spaces a tab displays as obtained with a call to
  716. !  GET_INFO (CURRENT_BUFFER, "TAB_STOPS").  Line is stripped of the leading
  717. !  space on return, and the function returns the number of spaces occupied
  718. !  on the screen.
  719. !
  720. PROCEDURE vi$vis_indent (line, tabstops)
  721.     LOCAL
  722.         idx,
  723.         cur_ch,
  724.         cnt;
  725.  
  726.     idx := 1;
  727.     cnt := 0;
  728.  
  729.     LOOP
  730.         cur_ch := SUBSTR (line, idx, 1);
  731.         EXITIF (INDEX ("    ", cur_ch) = 0);
  732.  
  733.         IF (cur_ch = " ") THEN
  734.             cnt := cnt + 1;
  735.         ELSE
  736.             cnt := cnt + (tabstops - (cnt - ((cnt / tabstops) * tabstops)));
  737.         ENDIF;
  738.  
  739.         idx := idx + 1;
  740.     ENDLOOP;
  741.  
  742.     ! Truncate the line removing the leading whitespace.
  743.  
  744.     line := SUBSTR (line, idx, LENGTH (line) - idx + 1);
  745.     RETURN (cnt);
  746. ENDPROCEDURE;
  747.  
  748. !
  749. !  This procedure builds a string with as many tabs as possible to create
  750. !  the indentation level given by "len".  "tabstops" is the number of spaces
  751. !  a tab produces on the screen.
  752. !
  753. PROCEDURE vi$get_tabs (len, tabstops)
  754.     LOCAL
  755.         tab_text,
  756.         rstr;
  757.  
  758.     rstr := "";
  759.  
  760.     ! Select the proper tabbing text based on the setting of vi$use_tabs
  761.  
  762.     tab_text := "   ";
  763.     IF (vi$use_tabs = 0) THEN
  764.         tab_text := SUBSTR (vi$spaces, 1, tabstops);
  765.     ENDIF;
  766.  
  767.     LOOP
  768.         EXITIF (len = 0);
  769.         IF (len >= tabstops) THEN
  770.             len := len - tabstops;
  771.             rstr := rstr + tab_text;
  772.         ELSE
  773.             rstr := rstr + SUBSTR (vi$spaces, 1, len);
  774.             len := 0;
  775.         ENDIF;
  776.     ENDLOOP;
  777.  
  778.     RETURN (rstr);
  779. ENDPROCEDURE;
  780.  
  781. !
  782. !   This function should be used to abort the current keyboard stream.
  783. !   It will assure that a macro does not continue to operate after a
  784. !   failure.
  785. !
  786. PROCEDURE vi$abort (n)
  787.     vi$key_buf := 0;
  788.     RETURN (n);
  789. ENDPROCEDURE;
  790.  
  791. !
  792. !   Decide what the current line number is.
  793. !
  794. PROCEDURE vi$cur_line_no
  795.     LOCAL
  796.         pos,
  797.         cnt,
  798.         val,
  799.         opos;
  800.  
  801.     ON_ERROR
  802.         POSITION (pos);
  803.         IF (val > 1) THEN
  804.             val := val / 2;
  805.             cnt := cnt - val;
  806.         ELSE
  807.             POSITION (opos);
  808.             RETURN (cnt);
  809.         ENDIF;
  810.     ENDON_ERROR;
  811.  
  812.     opos := MARK (NONE);
  813.     val := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT") * 4 / 5;
  814.     IF (val = 0) THEN
  815.         val := 1;
  816.     ENDIF;
  817.     cnt := 1;
  818.     LOOP
  819.         pos := MARK (NONE);
  820.         MOVE_VERTICAL (-val);
  821.         cnt := cnt + val;
  822.     ENDLOOP;
  823. ENDPROCEDURE;
  824.  
  825. !
  826. !   Copy a buffer of keys for use later.  This routine is used mostly to
  827. !   make a copy of the last series of keystrokes from repeating when '.'
  828. !   is typed.
  829. !
  830. PROCEDURE vi$copy_keys (to_keys, from_keys)
  831.     LOCAL
  832.         pos;
  833.  
  834.     pos := MARK (NONE);
  835.     ERASE (to_keys);
  836.     POSITION (to_keys);
  837.     COPY_TEXT (from_keys);
  838.     POSITION (BEGINNING_OF (to_keys));
  839.     POSITION (pos);
  840. ENDPROCEDURE;
  841.  
  842. !
  843. !   Convert a string of characters into a buffer of key strokes.
  844. !
  845. PROCEDURE vi$str_to_keybuf (tstring, tbuf)
  846.     LOCAL
  847.         pos,
  848.         idx;
  849.  
  850.     idx := 1;
  851.     pos := MARK (NONE);
  852.     POSITION (BEGINNING_OF (tbuf));
  853.  
  854.     ! Note that a bug in TPU causes ill behavior if you try to ERASE
  855.     ! a buffer that TPU has never written anything into.
  856.  
  857.     SPLIT_LINE;
  858.     APPEND_LINE;
  859.     ERASE (tbuf);
  860.  
  861.     LOOP
  862.         EXITIF idx > LENGTH (tstring);
  863.         COPY_TEXT (STR (KEY_NAME (SUBSTR (tstring, idx, 1))));
  864.         MOVE_HORIZONTAL (1);
  865.         idx := idx + 1;
  866.     ENDLOOP;
  867.  
  868.     !  There must be 2 lines (the first should be blank) at the end of the
  869.     !  buffer to make it appear exactly as a key mapping.
  870.  
  871.     SPLIT_LINE;
  872.     SPLIT_LINE;
  873.  
  874.     POSITION (pos);
  875. ENDPROCEDURE;
  876.  
  877. !
  878. !   Save the key passed into the push back buffer.
  879. !
  880. PROCEDURE vi$push_a_key (ch)
  881.     LOCAL
  882.         pos;
  883.  
  884.     pos := MARK (NONE);
  885.     POSITION (vi$cur_keys);
  886.     COPY_TEXT (STR (ch));
  887.     MOVE_HORIZONTAL (1);
  888.     POSITION (pos);
  889. ENDPROCEDURE;
  890.  
  891. !
  892. !   Insert the buffer passed into the stream of key_board characters so
  893. !   that they act as a macro.
  894. !
  895. PROCEDURE vi$insert_macro_keys (key_buf)
  896.     LOCAL
  897.         spos,
  898.         pos;
  899.  
  900.     IF vi$push_key_buf = 0 THEN
  901.         vi$push_key_buf := vi$init_buffer ("$$push_key_buf$$", "");
  902.     ENDIF;
  903.  
  904.     pos := MARK (NONE);
  905.  
  906.     IF (vi$key_buf <> 0) THEN
  907.         IF (vi$key_buf = vi$push_key_buf) THEN
  908.             POSITION (vi$push_key_buf);
  909.             MOVE_HORIZONTAL (-1);
  910.             spos := MARK (NONE);
  911.             MOVE_HORIZONTAL (1);
  912.             SET (INSERT, CURRENT_BUFFER);
  913.             COPY_TEXT (key_buf);
  914.  
  915.             !  Remove blank line at end, and possible DEFINE_KEY mapping.
  916.  
  917.             MOVE_VERTICAL (-1);
  918.             ERASE_LINE;
  919.             MOVE_VERTICAL (-1);
  920.             ERASE_LINE;
  921.  
  922.             POSITION (spos);
  923.             MOVE_HORIZONTAL (1);
  924.         ELSE
  925.             POSITION (vi$key_buf);
  926.             spos := MARK (NONE);
  927.             ERASE (vi$push_key_buf);
  928.             POSITION (vi$push_key_buf);
  929.             SET (INSERT, CURRENT_BUFFER);
  930.             COPY_TEXT (CREATE_RANGE (spos, END_OF (vi$key_buf), NONE));
  931.  
  932.             !  Remove blank line at end, and possible DEFINE_KEY mapping.
  933.  
  934.             MOVE_VERTICAL (-1);
  935.             ERASE_LINE;
  936.             MOVE_VERTICAL (-1);
  937.             ERASE_LINE;
  938.  
  939.             COPY_TEXT (key_buf);
  940.             POSITION (BEGINNING_OF (vi$push_key_buf));
  941.             vi$key_buf := vi$push_key_buf;
  942.         ENDIF;
  943.     ELSE
  944.         ERASE (vi$push_key_buf);
  945.         POSITION (vi$push_key_buf);
  946.         SET (INSERT, CURRENT_BUFFER);
  947.         COPY_TEXT (key_buf);
  948.         vi$key_buf := vi$push_key_buf;
  949.         POSITION (BEGINNING_OF (vi$push_key_buf));
  950.     ENDIF;
  951.  
  952.     POSITION (pos);
  953. ENDPROCEDURE;
  954.  
  955. !
  956. !   Erase a the last key pushed back.
  957. !
  958. PROCEDURE vi$del_a_key
  959.     LOCAL
  960.         pos;
  961.  
  962.     pos := MARK (NONE);
  963.     POSITION (vi$cur_keys);
  964.     IF MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER) THEN
  965.         MOVE_VERTICAL (-1);
  966.         ERASE_LINE;
  967.     ENDIF;
  968.     POSITION (pos);
  969.  
  970. ENDPROCEDURE;
  971.  
  972. !
  973. !   Read a single keystroke from either the keyboard, or from the push
  974. !   back buffer if it is non-zero.
  975. !
  976. PROCEDURE vi$read_a_key
  977.  
  978.     LOCAL
  979.         read_a_key,
  980.         pos,
  981.         ch;
  982.  
  983.     read_a_key := 0;
  984.  
  985.     ! If there are no keys pushed, then read the keyboard.
  986.  
  987.     IF (vi$key_buf = 0) OR (GET_INFO (vi$key_buf, "TYPE") <> BUFFER) THEN
  988.         read_a_key := 1;
  989.         vi$m_level := 0;
  990.         IF vi$term_vt200 THEN
  991.             ch := READ_KEY;
  992.         ELSE
  993.             ch := READ_CHAR;
  994.         ENDIF;
  995.     ELSE
  996.  
  997.         ! Otherwise extract the next key from the buffer.
  998.  
  999.         pos := MARK (NONE);
  1000.         POSITION (vi$key_buf);
  1001.  
  1002.         ! Get the key code.
  1003.  
  1004.         ch := INT (vi$current_line);
  1005.         MOVE_VERTICAL (1);
  1006.  
  1007.         ! Check for the end of the buffer.
  1008.  
  1009.         IF (LENGTH (vi$current_line) = 0) THEN
  1010.             vi$key_buf := 0;
  1011.         ENDIF;
  1012.  
  1013.         POSITION (pos);
  1014.     ENDIF;
  1015.  
  1016.     ! If we are not running on a VT200, then do some key translations
  1017.  
  1018.     IF NOT vi$term_vt200 THEN
  1019.         IF ch = ASCII(27) THEN
  1020.             ch := F11;
  1021.         ELSE
  1022.             ch := KEY_NAME (ch);
  1023.         ENDIF;
  1024.     ENDIF;
  1025.  
  1026.     ! If a key was read from the keyboard, then push it back.
  1027.  
  1028.     IF read_a_key THEN
  1029.         vi$push_a_key (ch);
  1030.     ENDIF;
  1031.  
  1032.     ! Save the last key read.
  1033.  
  1034.     vi$last_key := ch;
  1035.  
  1036.     ! Return the keycode of the character
  1037.  
  1038.     RETURN (ch);
  1039. ENDPROCEDURE;
  1040.  
  1041. !
  1042. !   Turn pasthru on, on the terminal
  1043. !
  1044. PROCEDURE vi$pasthru_on
  1045.     LOCAL
  1046.         junk;
  1047.     junk := CALL_USER (vi$cu_pasthru_on, "");
  1048. ENDPROCEDURE;
  1049.  
  1050. !
  1051. !   Turn pasthru off, on the terminal
  1052. !
  1053. PROCEDURE vi$pasthru_off
  1054.     LOCAL
  1055.         junk;
  1056.     junk := CALL_USER (vi$cu_pasthru_off, "");
  1057. ENDPROCEDURE;
  1058.  
  1059. !
  1060. !   Spawn with pasthru off
  1061. !
  1062. PROCEDURE vi$spawn (cmd)
  1063.     LOCAL
  1064.         junk;
  1065.  
  1066.     vi$pasthru_off;
  1067.     IF (cmd = 0) THEN
  1068.         SPAWN;
  1069.     ELSE
  1070.         SPAWN (cmd);
  1071.     ENDIF;
  1072.     vi$pasthru_on;
  1073. ENDPROCEDURE
  1074.  
  1075. !
  1076. !   Quit with pasthru off
  1077. !
  1078. PROCEDURE vi$quit
  1079.     vi$pasthru_off;
  1080.     QUIT;
  1081.     vi$pasthru_on;
  1082. ENDPROCEDURE
  1083.  
  1084. !
  1085. !   Perform read_line with pasthru off
  1086. !
  1087. PROCEDURE vi$read_line (prompt)
  1088.     LOCAL
  1089.         junk;
  1090.  
  1091.     vi$pasthru_off;
  1092.     junk := READ_LINE (prompt);
  1093.     vi$pasthru_on;
  1094.     RETURN (junk);
  1095. ENDPROCEDURE;
  1096.  
  1097. !
  1098. !   Initialize things by creating buffers and windows and perform other
  1099. !   assorted operations.
  1100. !
  1101. PROCEDURE tpu$init_procedure
  1102.  
  1103.     LOCAL
  1104.         journal_file,
  1105.         default_journal_name,
  1106.         aux_journal_name,
  1107.         cnt,
  1108.         input_file;
  1109.  
  1110.     !   Flag to indicate status of editor during startup.
  1111.  
  1112.     vi$starting_up := 1;
  1113.  
  1114.     vi$info_success_off;
  1115.     SET (MESSAGE_FLAGS, 1);
  1116.     SET (BELL, BROADCAST, ON);
  1117.  
  1118.     !   Set the variables to their initial values.
  1119.  
  1120.     vi$init_vars;
  1121.  
  1122.     !   Remove the definition of vi$init_vars to save memory.
  1123.  
  1124.     COMPILE ("procedure vi$init_vars; endprocedure;");
  1125.  
  1126.     !   Get some other information.
  1127.  
  1128.     vi$term_vt200 := GET_INFO (SCREEN, "vt200");
  1129.     vi$scr_width := GET_INFO (SCREEN, "WIDTH");
  1130.     vi$scr_length := GET_INFO (SCREEN, "VISIBLE_LENGTH");
  1131.  
  1132.     !   Create the message buffer and window.
  1133.  
  1134.     message_buffer := vi$init_buffer ("Messages", "");
  1135.     message_window := CREATE_WINDOW (vi$scr_length - 1, 2, ON);
  1136.     MAP (message_window, message_buffer);
  1137.     SET (STATUS_LINE, message_window, NONE, "");
  1138.     SET (MAX_LINES, message_buffer, 500);
  1139.     ADJUST_WINDOW (message_window, 1, 0);
  1140.     vi$mess_select (REVERSE);
  1141.  
  1142.     !   Command prompt area.
  1143.  
  1144.     command_buffer := vi$init_buffer ("Commands", "");
  1145.     command_window := CREATE_WINDOW (vi$scr_length, 1, OFF);
  1146.  
  1147.     !   Buffer for SHOW (xxx) stuff.
  1148.  
  1149.     show_buffer := vi$init_buffer ("Show", "");
  1150.     info_window := CREATE_WINDOW (1, vi$scr_length - 1, ON);
  1151.     SET (STATUS_LINE, info_window, NONE, "");
  1152.  
  1153.     !   A buffer for the tags file(s).
  1154.  
  1155.     vi$tag_buf := vi$init_buffer ("Tags buffer", "");
  1156.     vi$load_tags;
  1157.     vi$dcl_buf := vi$init_buffer ("DCL buffer", "[End of DCL buffer]");
  1158.     vi$info_success_off;
  1159.  
  1160.     !   A buffer and a window to start editing in.
  1161.  
  1162.     main_buffer := CREATE_BUFFER ("Main");
  1163.     main_window := CREATE_WINDOW (1, vi$scr_length - 1, ON);
  1164.     SET (EOB_TEXT, main_buffer, "[EOB]");
  1165.     SET (STATUS_LINE, main_window, NONE, "");
  1166.  
  1167.     !   A buffer for wild carding and such.
  1168.  
  1169.     choice_buffer := vi$init_buffer ("Choices", "");
  1170.  
  1171.     !   A buffer for the list of files we are currently editing.
  1172.  
  1173.     vi$file_names := vi$init_buffer ("file_names", "");
  1174.  
  1175.     !   Buffer to hold last text inserted into a buffer.
  1176.  
  1177.     vi$last_insert := vi$init_buffer ("$$last_insert$$", "");
  1178.  
  1179.     !   Buffer to hold KEY_NAME values of last key sequence.
  1180.  
  1181.     vi$cur_keys := vi$init_buffer ("$$current_keys$$", "");
  1182.  
  1183.     !   Buffer to hold keys to be performed when '.' is pressed.
  1184.  
  1185.     vi$last_keys := vi$init_buffer ("$$last_keys$$", "");
  1186.  
  1187.     !   Get a buffer to hold yank and deletes that are not aimed a named
  1188.     !   buffer.
  1189.  
  1190.     vi$temp_buf := vi$init_buffer ("$$temp_buffer$$", "");
  1191.  
  1192.     !   Set up some more stuff.
  1193.  
  1194.     SET (PROMPT_AREA, vi$scr_length, 1, BOLD);
  1195.     SET (JOURNALING, 7);
  1196.     SET (FACILITY_NAME, "VI");
  1197.  
  1198.     !   Move to the initial buffer.
  1199.  
  1200.     MAP (main_window, main_buffer);
  1201.     POSITION (main_buffer);
  1202.  
  1203.     !   Get the filename to edit.
  1204.  
  1205.     input_file := GET_INFO (COMMAND_LINE, "FILE_NAME");
  1206.  
  1207.     !   If there is an input file, then get it for editing.
  1208.  
  1209.     IF input_file <> "" THEN
  1210.         cnt := vi$get_file (input_file);
  1211.     ENDIF;
  1212.  
  1213.     ! Delete the unused main buffer if it is not used.
  1214.  
  1215.     IF (CURRENT_BUFFER <> main_buffer) THEN
  1216.         DELETE (main_buffer);
  1217.     ENDIF;
  1218.  
  1219.     ! Start journaling if requested.
  1220.  
  1221.     IF (GET_INFO (COMMAND_LINE, "JOURNAL") = 1) THEN
  1222.         aux_journal_name := GET_INFO (CURRENT_BUFFER, "FILE_NAME");
  1223.  
  1224.         IF aux_journal_name = "" THEN
  1225.             aux_journal_name := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE");
  1226.         ENDIF;
  1227.  
  1228.         IF aux_journal_name = 0 THEN
  1229.             aux_journal_name := "";
  1230.         ENDIF;
  1231.  
  1232.         IF aux_journal_name = "" THEN
  1233.             default_journal_name := "MAIN.TJL";
  1234.         ELSE
  1235.             default_journal_name := ".TJL";
  1236.         ENDIF;
  1237.  
  1238.         journal_file := GET_INFO (COMMAND_LINE, "JOURNAL_FILE");
  1239.         journal_file := FILE_PARSE (journal_file, default_journal_name,
  1240.                                                     aux_journal_name);
  1241.         JOURNAL_OPEN (journal_file);
  1242.     ENDIF;
  1243.  
  1244.     ! Force undefined keystrokes ("all of them") to call vi$command_mode.
  1245.  
  1246.     SET (UNDEFINED_KEY, "tpu$key_map_list",
  1247.                                     COMPILE ("vi$command_mode (LAST_KEY)"));
  1248.     SET (SELF_INSERT, "tpu$key_map_list", OFF);
  1249.  
  1250.     vi$info_success_on;
  1251.  
  1252.     ! Change PF1 so that it is NOT a shift key.
  1253.  
  1254.     SET (SHIFT_KEY, KEY_NAME (PF1, SHIFT_KEY));
  1255.  
  1256.     ! Do any user added local initialization.
  1257.  
  1258.     tpu$local_init;
  1259.  
  1260.     ! Do the INI file.
  1261.  
  1262.     IF FILE_SEARCH ("EXRC") = "" THEN
  1263.         vi$do_file ("SYS$LOGIN:VI.INI", 0);
  1264.     ELSE
  1265.         vi$do_file ("EXRC", 0);
  1266.     ENDIF;
  1267.  
  1268.     vi$do_exinit;
  1269.  
  1270.     ! Enable passthru on the terminal so that ^Y does 'Push screen'.
  1271.  
  1272.     vi$pasthru_on;
  1273.  
  1274.     ! Say we are no longer starting up.
  1275.  
  1276.     vi$starting_up := 0;
  1277. ENDPROCEDURE;
  1278.  
  1279. !
  1280. !   Process the EXINIT environment variable (Process Logical actually).
  1281. !
  1282. PROCEDURE vi$do_exinit
  1283.     LOCAL
  1284.         exinit;
  1285.  
  1286.     ON_ERROR
  1287.         RETURN;
  1288.     ENDON_ERROR;
  1289.  
  1290.     exinit := call_user (vi$cu_trnlnm_job, "EXINIT");
  1291.     vi$do_cmd_line (exinit);
  1292. ENDPROCEDURE;
  1293.  
  1294. !
  1295. !   Load the file given in fn, into a buffer and execute the contents as
  1296. !   a series of EX mode commands.  "complain" is boolean, and determines
  1297. !   whether or not we complain about a non existant file.
  1298. !
  1299. PROCEDURE vi$do_file (rfn, complain)
  1300.     LOCAL
  1301.         fn,
  1302.         ini_buffer,
  1303.         ini_file;
  1304.  
  1305.     MESSAGE ("");
  1306.     fn := rfn;
  1307.     ini_file := FILE_SEARCH ("");
  1308.     fn := FILE_PARSE (fn);
  1309.     ini_file := FILE_SEARCH (fn);
  1310.     IF (ini_file = "") THEN
  1311.         IF (complain) THEN
  1312.             vi$message ("Can't find file """+fn+"""!");
  1313.         ENDIF;
  1314.         RETURN (1);
  1315.     ENDIF;
  1316.  
  1317.     vi$info_success_off;
  1318.  
  1319.     ini_buffer := CREATE_BUFFER ("VI$CMD$INI$$", ini_file);
  1320.  
  1321.     IF ini_buffer = 0 THEN
  1322.         IF (complain) THEN
  1323.             vi$message ("can't process file """+ini_file+"""!");
  1324.         ENDIF;
  1325.         vi$info_success_on;
  1326.         RETURN(1);
  1327.     ENDIF;
  1328.  
  1329.     vi$process_buffer (ini_buffer);
  1330.     DELETE (ini_buffer);
  1331.  
  1332.     vi$info_success_on;
  1333.     RETURN (1);
  1334. ENDPROCEDURE;
  1335.  
  1336. !
  1337. !  Execute the contents of the passed buffer as EX mode commands
  1338. !
  1339. PROCEDURE vi$process_buffer (buffer_parm)
  1340.  
  1341.     LOCAL
  1342.         line,
  1343.         old_pos,
  1344.         cur_pos;
  1345.  
  1346.     old_pos := MARK (NONE);
  1347.     POSITION (BEGINNING_OF (buffer_parm));
  1348.  
  1349.     LOOP
  1350.         cur_pos := MARK (NONE);
  1351.         EXITIF (cur_pos = END_OF (buffer_parm));
  1352.         line := CURRENT_LINE;
  1353.  
  1354.         IF (LENGTH (line) > 0) AND (SUBSTR (line, 1, 1) <> '!') THEN
  1355.             POSITION (old_pos);
  1356.  
  1357.             vi$do_cmd_line (line);
  1358.  
  1359.             old_pos := MARK (NONE);
  1360.             POSITION (cur_pos);
  1361.         ENDIF;
  1362.  
  1363.         MOVE_VERTICAL (1);
  1364.     ENDLOOP;
  1365.  
  1366.     POSITION (old_pos);
  1367. ENDPROCEDURE;
  1368.  
  1369. !
  1370. !
  1371. !
  1372. PROCEDURE vi$init_buffer (new_buffer_name, new_eob_text)
  1373.  
  1374.     LOCAL
  1375.         new_buffer;         ! New buffer
  1376.  
  1377.     new_buffer := CREATE_BUFFER (new_buffer_name);
  1378.     SET (EOB_TEXT, new_buffer, new_eob_text);
  1379.     SET (NO_WRITE, new_buffer);
  1380.     SET (SYSTEM, new_buffer);
  1381.     RETURN (new_buffer);
  1382.  
  1383. ENDPROCEDURE;
  1384.  
  1385. !
  1386. !   Expand the list of filenames given in "get_file_list" and return
  1387. !   the count of names found as the function value.  One possible
  1388. !   match will be returned in one_name so that if only one file matches,
  1389. !   one_name will contain that file.
  1390. !
  1391. PROCEDURE vi$expand_file_list (get_file_list)
  1392.  
  1393.     LOCAL
  1394.         num_names,
  1395.         fres,
  1396.         one_name,
  1397.         fn,
  1398.         fl,
  1399.         comma_pos,
  1400.         pos;
  1401.  
  1402.     fl := get_file_list;
  1403.  
  1404.     ERASE (choice_buffer);
  1405.  
  1406.     IF (vi$file_names = 0) THEN
  1407.         vi$file_names := vi$init_buffer ("file_names", "");
  1408.     ELSE
  1409.         ERASE (vi$file_names);
  1410.     ENDIF;
  1411.  
  1412.     LOOP
  1413.         ! Protect against earlier file_search.
  1414.  
  1415.         fres := FILE_SEARCH ("");
  1416.  
  1417.         EXITIF fl = "";
  1418.         comma_pos := INDEX (fl, ",");
  1419.  
  1420.         IF (comma_pos > 0) THEN
  1421.             fn := SUBSTR (fl, 1, comma_pos - 1);
  1422.             fl := SUBSTR (fl, comma_pos + 1, LENGTH (fl) - comma_pos);
  1423.         ELSE
  1424.             fn := fl;
  1425.             fl := "";
  1426.         ENDIF;
  1427.  
  1428.         LOOP
  1429.             fres := FILE_SEARCH (fn);
  1430.             EXITIF fres = "";
  1431.             vi$add_choice (fres);
  1432.             one_name := fres;
  1433.         ENDLOOP;
  1434.  
  1435.     ENDLOOP;
  1436.  
  1437.     pos := MARK (NONE);
  1438.  
  1439.     POSITION (vi$file_names);
  1440.     COPY_TEXT (choice_buffer);
  1441.     POSITION (BEGINNING_OF (vi$file_names));
  1442.  
  1443.     POSITION (pos);
  1444.  
  1445.     num_names := GET_INFO (choice_buffer, "RECORD_COUNT");
  1446.  
  1447.     RETURN (num_names);
  1448. ENDPROCEDURE;
  1449. !
  1450. ! Put a file in the current window.  If the file is already in a buffer,
  1451. ! use the old buffer.  If not, create a new buffer.
  1452. !
  1453. ! Parameters:
  1454. !
  1455. !   file_parameter  String containing file name - input
  1456. !
  1457. PROCEDURE vi$get_file (file_parameter)
  1458.  
  1459.     LOCAL
  1460.         pos,
  1461.         obuf,
  1462.         get_file_parm,
  1463.         outfile,
  1464.         filename,
  1465.         file_read,
  1466.         get_file_name,          ! Local copy of get_file_parameter
  1467.         get_file_list,          ! Possible comma separated list
  1468.         temp_buffer_name,       ! String for buffer name based on get_file_name
  1469.         file_search_result,     ! Latest string returned by file_search
  1470.         temp_file_name,         ! First file name string returned by file_searc
  1471. h
  1472.         loop_cnt,               ! Number of files left to process in loop
  1473.         file_cnt,               ! Actual number of files found with FILE_SEARCH
  1474.         loop_buffer,            ! Buffer currently being checked in loop
  1475.         new_buffer,             ! New buffer created if needed
  1476.         found_a_buffer,         ! True if buffer found with same name
  1477.         want_new_buffer;        ! True if file should go into a new buffer
  1478.  
  1479.     ON_ERROR
  1480.         IF ERROR = TPU$_PARSEFAIL THEN
  1481.             vi$message (FAO ("Don't understand file name: !AS", get_file_name))
  1482. ;
  1483.             RETURN (0);
  1484.         ENDIF;
  1485.     ENDON_ERROR;
  1486.  
  1487.     obuf := CURRENT_BUFFER;
  1488.     get_file_parm := file_parameter;
  1489.     IF (get_file_parm = 0) OR (get_file_parm = "") THEN
  1490.         vi$message ("File name must be supplied!");
  1491.         RETURN (0);
  1492.     ENDIF;
  1493.  
  1494.     get_file_list := get_file_parm;
  1495.     get_file_name := get_file_parm;
  1496.     temp_file_name := 0;
  1497.  
  1498.     loop_cnt := vi$expand_file_list (get_file_list);
  1499.  
  1500.     !   If none were found, then set up to enter the loop and get a new buffer
  1501.  
  1502.     IF (loop_cnt = 0) THEN
  1503.         loop_cnt := 1;
  1504.         POSITION (BEGINNING_OF (choice_buffer));
  1505.     ELSE
  1506.         IF loop_cnt > 1 THEN
  1507.             vi$message (FAO ("!UL files to edit!", loop_cnt));
  1508.         ENDIF;
  1509.         POSITION (BEGINNING_OF (choice_buffer));
  1510.         temp_file_name := vi$current_line;
  1511.         ERASE_LINE;
  1512.     ENDIF;
  1513.  
  1514. $$EOD$$
  1515.