home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol083 / ice.pli < prev    next >
Encoding:
Text File  |  1984-04-29  |  29.2 KB  |  989 lines
  1. ICE : procedure options(main);
  2.    
  3. /**************************************************/
  4. /*                                                */
  5. /*       IN CONTEXT EDITOR                        */
  6. /*                                                */
  7. /*        Re-implementation of ICE written by     */
  8. /*        P. G. Main in Ratfor.                   */
  9. /*                                                */
  10. /*        Paul Tilden  Aug 1981                   */
  11. /*                                                */
  12. /*  IMPORTANT:  To avoid confusion, the word      */
  13. /*  LINE is used exclusively to refer to lines    */
  14. /*  on the VDU screen, and ROW to refer to data   */
  15. /*  in the working buffer BUF.                    */
  16. /*                                                */
  17. /**************************************************/
  18.    
  19. %replace
  20.     true      by '1'b,
  21.     false     by '0'b;
  22. %replace
  23.     huge      by 32000,
  24.     linelen   by 100,    /* screen width */
  25.     scrlen    by 16,     /* screen length */
  26.     size      by 100;    /* nr. of rows in buf */
  27. %replace
  28.     escape    by 27,
  29.     line_feed by 10;
  30.    
  31. declare
  32.     (edt_in, edt_out, sysin, sysprint) file;
  33. declare
  34.     nextout   fixed,     /* next row to be output from buf */
  35.     lastin    fixed,     /* last row input to buf */
  36.     posn      fixed,     /* equal to rmod(crow - lastin) */
  37.     crow      fixed,     /* current row */
  38.     delrows   fixed,     /* nr. of rows to be deleted but
  39.                            not yet read */
  40.     inrow     fixed,     /* infile row nr. of lastin */
  41.     inopen    bit(1),    /* flag saying an input file is open */
  42.     file_end  bit(1),    /* eof on edt_in */
  43.     abort     bit(1),    /* abort edit */
  44.     scr_row   fixed,     /* screen row */
  45.     scr_col   fixed;     /* screen column */
  46. declare
  47.     1 buf(size),
  48.         2 buf_row character(linelen) varying;
  49. declare
  50.     upper character(26) static initial
  51.           ('ABCDEFGHIJKLMNOPQRSTUVWXYZ'),
  52.     lower character(26) static initial
  53.           ('abcdefghijklmnopqrstuvwxyz'),
  54.     digit character(10) static initial ('0123456789'),
  55.     blanks character(linelen) varying static;
  56.    
  57.    
  58. /********************************************************/
  59. /*                                                      */
  60. /*                MAIN PROCEDURE                        */
  61. /*                                                      */
  62. /********************************************************/
  63.    
  64.         /* initialization */
  65.     open file(sysprint) print pagesize(0) 
  66.          linesize(255)
  67.          title('$CON');
  68.         begin;
  69.         declare i fixed;
  70.         do i = 1 to size;
  71.             buf_row(i) = '';
  72.         end;
  73.         blanks = '';
  74.         do i = 1 to linelen;
  75.             blanks = blanks !! ' ';
  76.         end;
  77.         end;
  78.     call home_cursor;
  79.     call clear_screen;
  80.     nextout = 1;
  81.     lastin = size;
  82.     crow = lastin;
  83.     posn = size;
  84.     inrow = 0;
  85.     delrows = 0;
  86.     on undefinedfile(edt_in)
  87.         begin;
  88.         call diag('new file');
  89.         inopen = false;
  90.         file_end = true;
  91.         goto edtin_cont;
  92.         end;
  93.     open file(edt_in) input stream env(b(2048)) title('$1.$1');
  94.     inopen = true;
  95.     file_end = false;
  96.     revert undefinedfile(edt_in);
  97.     edtin_cont: ;
  98.     open file(edt_out) output stream pagesize(0) env(b(2048))
  99.          title('$1.%%%');
  100.     call get_row(lastin);
  101.     call spray(scrlen-2,scrlen-2);
  102.    
  103.         /* edit file */
  104.     call edit_file;
  105.    
  106.         /* file cleanup */
  107.     close file(edt_in);
  108.     close file(edt_out);
  109.    
  110.         /* end */
  111.     call diag('done');
  112.    
  113. /********************************************************/
  114. /*                                                      */
  115. /*             EDIT FILE                                */
  116. /*                                                      */
  117. /********************************************************/
  118.   
  119. edit_file: procedure;
  120.     declare
  121.         done        bit(1),   /* true = return to main proc. */
  122.         (cc1, cc2, cc3, cc4) character(1), /* command chars. */
  123.         (cmdbuf,              /* complete command buffer */
  124.          oprnd,               /* command buffer less command */
  125.          cmdsave,             /* complete command buffer
  126.                                  save for same command */
  127.          locsave)             /* complete command buffer
  128.                                  save for more command */
  129.                     character(linelen) varying,
  130.         number      fixed;    /* number following command */
  131.     done = false;
  132.     do while (^done);
  133.         call get_command;
  134.         call execute_command;
  135.     end;
  136.     if ^abort then
  137.         begin; /* move remainder of edit file to output file */
  138.         declare
  139.             row fixed;
  140.         row = nextout;
  141.             drain_buf:
  142.             call put_row(row);
  143.             row = rmod(row+1);
  144.             if row ^= nextout then goto drain_buf;
  145.         do while (^file_end);
  146.             call get_row(row);
  147.             call put_row(row);
  148.         end;
  149.         end;
  150.             
  151. /********************************************************/
  152. /*                                                      */
  153. /*                GET COMMAND LINE                      */
  154. /*                                                      */
  155. /********************************************************/
  156.   
  157. get_command: procedure;
  158.     call cursor_pos(1,scrlen-1);
  159.     call vdu_out('*');
  160.     call vdu_in(cmdbuf);
  161.     call cursor_pos(1,scrlen-1);
  162.     call clear_screen;
  163.     if length(cmdbuf) = 1 then
  164.         begin;
  165.         declare
  166.             (ch, zz) character(1);
  167.         zz = substr(cmdbuf, 1, 1);
  168.         ch = translate(zz, lower, upper);
  169.         if ch = 's' then
  170.             cmdbuf = cmdsave;  /* same command */
  171.         if ch = 'm' then
  172.             cmdbuf = locsave;  /* more command */
  173.         end;
  174.     /* extract command characters */
  175.     cc1 = ' ';  cc2 = ' ';  cc3 = ' ';  cc4 = ' ';
  176.     declare
  177.         (i, j) fixed;
  178.     if length(cmdbuf) = 0 then
  179.         i = 1;
  180.     else
  181.         do;
  182.         do i = 1 to length(cmdbuf)
  183.         while (verify(translate(substr(cmdbuf,i,1),lower,upper),
  184.                      lower) = 0);
  185.             substr(cmdbuf,i,1) = translate(substr(cmdbuf,i,1),
  186.                                            lower, upper);
  187.         end;
  188.         do j = 1 to length(cmdbuf) while (j<=4);
  189.             if j = 1 then cc1 = substr(cmdbuf,1,1);
  190.             if j = 2 then cc2 = substr(cmdbuf,2,1);
  191.             if j = 3 then cc3 = substr(cmdbuf,3,1);
  192.             if j = 4 then cc4 = substr(cmdbuf,4,1);
  193.         end;
  194.     end;
  195.     if i <= length(cmdbuf) then
  196.         if substr(cmdbuf,i,1) = ' ' then
  197.             i = i+1;  /* remove space following command */
  198.     number = 0;  /* convert number following command */
  199.     if i <= length(cmdbuf) then
  200.         if substr(cmdbuf,i,1) = '*' then
  201.             number = huge;
  202.         else
  203.             begin;
  204.             declare
  205.                 ch character(1);
  206.             do j = i to length(cmdbuf)
  207.                 while (verify(substr(cmdbuf,j,1), digit) = 0);
  208.                 ch = substr(cmdbuf,j,1);
  209.                 number = number * 10 +
  210.                          rank(ch) - rank('0');
  211.             end;
  212.             end;
  213.     if number <= 0 then
  214.         number = 1;
  215.     oprnd = substr(cmdbuf, i);
  216. end get_command;
  217.   
  218. /*******************************************************/
  219.   
  220. /*******************************************************/
  221. /*                                                     */
  222. /*              EXECUTE COMMAND                        */
  223. /*                                                     */
  224. /*******************************************************/
  225.   
  226. execute_command: procedure;
  227.     declare
  228.         error bit(1);    /* true = line would be trancated */
  229.     error = false;
  230.          if cc1 = 'a' then call ex_append;
  231.     else if cc1 = 'c' then call ex_change;
  232.     else if cc1 = 'd' then call ex_delete;
  233.     else if cc1 = 'f' then call ex_find;
  234.     else if cc1 = 'i' then call ex_insert;
  235.     else if cc1 = 'l' then
  236.              if cc2 = 'c' then call ex_line_change;
  237.              else if cc2 = 'e' then call ex_length;
  238.              else call ex_locate;
  239.     else if cc1 = 'm' & cc2 = 'o' then call ex_modify;
  240.     else if cc1 = 'n' then
  241.              if cc2 = 'p' then call ex_number_plus;
  242.              else call ex_number;
  243.     else if cc1 = 'o' then call ex_overtype;
  244.     else if cc1 = 'p' then
  245.              if cc2 = 'a' then call ex_paste;
  246.              else if cc2 = '-' then call ex_page_down;
  247.              else call ex_page_up;
  248.     else if cc1 = 'q' then call ex_quit;
  249.     else if cc1 = 'r' then call ex_replace;
  250.     else if cc1 = 'w' then call ex_write;
  251.     else if cc1 = '-' then call ex_line_down;
  252.     else if cc1 = ' ' then call ex_line_up;
  253.     else call diag('illegal command');
  254.     if error then
  255.         call diag('line would be too long');
  256.     if posn = size & file_end &
  257.        length(buf_row(crow)) = 0 & ^done then
  258.         if inopen then
  259.             call diag('end of file');
  260.         else
  261.             call diag('no input file open');
  262.     if rmod(lastin+1) ^= nextout then   /* problem */
  263.         do;
  264.         call diag('help - lastin error');
  265.         done = true;
  266.         abort = true;
  267.         end;
  268.     if rmod(crow-lastin) ^= posn then   /* problem */
  269.         do;
  270.         call diag('help - posn error');
  271.         done = true;
  272.         abort = true;
  273.         end;
  274.   
  275. /********************************************************/
  276. /*                                                      */
  277. /*             COMMAND EXECUTORS                        */
  278. /*                                                      */
  279. /********************************************************/
  280.   
  281. /* A - append operand to current line */
  282. ex_append: procedure;
  283.     cmdsave = cmdbuf;
  284.     if length(oprnd) + length(buf_row(crow)) > linelen then
  285.         error = true;
  286.     else
  287.         do;
  288.         buf_row(crow) = buf_row(crow) !! oprnd;
  289.         call spray(scrlen-2, scrlen-2);
  290.         end;
  291. end ex_append;
  292.   
  293. /* C - change 1st. occurence of string in current line */
  294. ex_change: procedure;
  295.     cmdsave = cmdbuf;
  296.     declare
  297.         (key, subst) character (linelen) varying,
  298.         (key_len, key_posn, i) fixed;
  299.     call split_string(oprnd, key, subst);
  300.     i = length(buf_row(crow));
  301.     if match(buf_row(crow), 1, i,
  302.              key, key_len, key_posn) then
  303.         do;
  304.         call change(buf_row(crow), key_len, key_posn,
  305.                     subst, error);
  306.         call spray(scrlen-2, scrlen-2);
  307.         end;
  308.     else
  309.         call diag('no match');
  310. end ex_change;
  311.   
  312. /* D - delete n lines including current line */
  313. ex_delete: procedure;
  314.     delrows = number;
  315.     call blank;
  316.     call compress_up;
  317.     call spray(scrlen-2, scrlen-2);
  318. end ex_delete;
  319.   
  320. /* F - find next line containing operand in column 1 */
  321. ex_find: procedure;
  322.     locsave = cmdbuf;
  323.     declare
  324.         (junk1, junk2) fixed;
  325.         find_loop:
  326.         if crow = lastin then call swap;
  327.         crow = rmod(crow+1);
  328.         if ^(match(buf_row(crow), 1, 1, oprnd, junk1, junk2) !
  329.             (file_end & crow = lastin)) then goto find_loop;
  330.     posn = rmod(crow - lastin);
  331.     call spray(1, scrlen-2);
  332. end ex_find;
  333.   
  334. /* I - insert lines or operand of command */
  335. ex_insert: procedure;
  336.     if length(oprnd) = 0 then
  337.         do;
  338.         call input_lines;
  339.         call spray(scrlen-2, scrlen-2);
  340.         end;
  341.     else
  342.         do;
  343.         cmdsave = cmdbuf;
  344.         call insert_line;
  345.         buf_row(crow) = oprnd;
  346.         call spray(scrlen-2, scrlen-2);
  347.         end;
  348. end ex_insert;
  349.   
  350. /* LE - length of line */
  351. ex_length: procedure;
  352.     call diag(character(length(buf_row(crow))) !! ' chars');
  353. end ex_length;
  354.   
  355. /* LC - change all occurrences of string in current line */
  356. ex_line_change: procedure;
  357.     cmdsave = cmdbuf;
  358.     declare
  359.         (key, subst) character (linelen) varying,
  360.         (junk1, junk2, i) fixed;
  361.     call split_string(oprnd, key, subst);
  362.     i = length(buf_row(crow));
  363.     if match(buf_row(crow), 1, i,
  364.              key, junk1, junk2) then
  365.         do;
  366.         call line_change(buf_row(crow), key, subst, error);
  367.         call spray(scrlen-2, scrlen-2);
  368.         end;
  369.     else
  370.         call diag('no match');
  371. end ex_line_change;
  372.   
  373. /* L - locate next line containing operand */
  374. ex_locate: procedure;
  375.     locsave = cmdbuf;
  376.     declare
  377.         (junk1, junk2, i) fixed;
  378.         locate_loop:
  379.         if crow = lastin then
  380.             call swap;
  381.         crow = rmod(crow+1);
  382.         i = length(buf_row(crow));
  383.         if ^(match(buf_row(crow),1,i,
  384.                    oprnd, junk1, junk2) !
  385.              (file_end & crow = lastin)) then goto locate_loop;
  386.     posn = rmod(crow-lastin);
  387.     call spray(1,scrlen-2);
  388. end ex_locate;
  389.   
  390. /* MO - modify line */
  391. ex_modify: procedure;
  392.     call diag('not yet implemented');
  393. end ex_modify;
  394.   
  395. /* N - goto nominated line */
  396. ex_number: procedure;
  397.     declare
  398.         row fixed;
  399.     row = number;
  400.     if row < inrow-size+1 then
  401.         call diag('already past');
  402.     else
  403.         if row > inrow+scrlen-2 then
  404.             do;
  405.             do while(^(inrow = row ! file_end));
  406.                 call swap;
  407.             end;
  408.             crow = lastin;
  409.             posn = size;
  410.             call spray(1,scrlen-2);
  411.             end;
  412.         else
  413.             do;
  414.             do while((row > inrow-size+posn) & 
  415.                      ^(posn = size & file_end));
  416.                 call roll_up;
  417.             end;
  418.             do while(row < inrow-size+posn);
  419.                 call roll_down;
  420.             end;
  421.             end;
  422. end ex_number;
  423.   
  424. /* NP - goto n lines past current line */
  425. ex_number_plus: procedure;
  426.     locsave = cmdbuf;
  427.     declare
  428.         row fixed;
  429.     row = number+inrow-size+posn;
  430.     if row > inrow+scrlen-2 then
  431.         do;
  432.         do while(^(inrow = row ! file_end));
  433.             call swap;
  434.         end;
  435.         crow = lastin;
  436.         posn = size;
  437.         call spray(1,scrlen-2);
  438.         end;
  439.     else
  440.         do;
  441.         do while((row > inrow-size+posn) & 
  442.                  ^(posn = size & file_end));
  443.             call roll_up;
  444.         end;
  445.         end;
  446. end ex_number_plus;
  447.   
  448. /* O - overtype -- delete n lines and input from vdu */
  449. ex_overtype: procedure;
  450.     delrows = number;
  451.     call blank;
  452.     call input_lines;
  453.     call spray(scrlen-2, scrlen-2);
  454. end ex_overtype;
  455.   
  456. /* P - roll up one or more pages */
  457. ex_page_up: procedure;
  458.     declare
  459.         i fixed;
  460.     do i = 1 to (scrlen-3)*number while(^(posn = size &
  461.                                           file_end));
  462.         call roll_up;
  463.     end;
  464. end ex_page_up;
  465.   
  466. /* P- -- roll down one page */
  467. ex_page_down: procedure;
  468.     declare
  469.         i fixed;
  470.     do i = 1 to (scrlen-3);
  471.         call roll_down;
  472.     end;
  473. end ex_page_down;
  474.   
  475. /* PA - paste -- change all occurences of string until eof */
  476. ex_paste: procedure;
  477.     cmdsave = cmdbuf;
  478.     declare
  479.         (key, subst) character (linelen) varying,
  480.         (junk1, junk2, i) fixed;
  481.     call split_string(oprnd, key, subst);
  482.     do while(^(posn = size & file_end) & ^error);
  483.         i = length(buf_row(crow));
  484.         if match(buf_row(crow), 1, i,
  485.                  key, junk1, junk2) then
  486.             do;
  487.             call line_change(buf_row(crow), key, subst, error);
  488.             call scroll_up;
  489.             call spray(scrlen-2, scrlen-2);
  490.             end;
  491.         if ^error then
  492.             do;
  493.             if crow = lastin then
  494.                 call swap;
  495.             crow = rmod(crow+1);
  496.             posn = rmod(crow-lastin);
  497.             end;
  498.     end;
  499. end ex_paste;
  500.   
  501. /* Q - quit -- no change to file */
  502. ex_quit: procedure;
  503.     abort = true;
  504.     done = true;
  505. end ex_quit;
  506.   
  507. /* R - replace current line with operand */
  508. ex_replace: procedure;
  509.     cmdsave = cmdbuf;
  510.     buf_row(crow) = oprnd;
  511.     call compress_up;
  512.     call spray(scrlen-2, scrlen-2);
  513. end ex_replace;
  514.   
  515. /* W - write file -- end edit */
  516. ex_write: procedure;
  517.     done = true;
  518. end ex_write;
  519.   
  520. /* - -- roll down 1 line */
  521. ex_line_down: procedure;
  522.     call roll_down;
  523. end ex_line_down;
  524.   
  525. /* return - roll up one line */
  526. ex_line_up: procedure;
  527.     call roll_up;
  528. end ex_line_up;
  529.   
  530. end execute_command;
  531.   
  532. /********************************************************/
  533.   
  534. end edit_file;
  535.   
  536. /********************************************************/
  537.   
  538.     
  539. /********************************************************/
  540. /*                                                      */
  541. /*           GENERAL SUPPORT PROCEDURES                 */
  542. /*                                                      */
  543. /********************************************************/
  544.     
  545.         /* blank - clear delrows in buf from crow and spray */
  546. blank: procedure;
  547.     declare
  548.         row fixed;
  549.     row = crow;
  550.         blank_loop:
  551.         buf_row(row) = '';
  552.         delrows = delrows-1;
  553.         row = rmod(row+1);
  554.         if ^(delrows <= 0 ! row = nextout) then
  555.             goto blank_loop;
  556.     call spray(scrlen-2,scrlen-2);
  557. end blank;
  558.     
  559.         /* change - replace len chars. starting at
  560.                     string(place) by subst */
  561. change: procedure(string, len, place, subst, error);
  562.     declare
  563.         (string, subst) character(linelen) varying,
  564.         (len, place) fixed,
  565.         error bit(1);
  566.     if length(string)+length(subst)-len > linelen then
  567.         error = true;
  568.     else
  569.         do;
  570.         error = false;
  571.         string = substr(string,1,place-1) !!
  572.                  subst !!
  573.                  substr(string,place+len);
  574.         end;
  575. end change;
  576.     
  577.         /* compress_up - compress buf upwards and re-fill
  578.                          from below */
  579. compress_up: procedure;
  580.     declare
  581.         (lf, lt) fixed;
  582.     lf = crow;
  583.     do while (lf ^= nextout & length(buf_row(lf)) = 0);
  584.         lf = rmod(lf+1);
  585.     end;
  586.     lt = crow;
  587.     do while (lf ^= nextout);
  588.         buf_row(lt) = buf_row(lf);
  589.         lf = rmod(lf+1);
  590.         lt = rmod(lt+1);
  591.     end;
  592.     do while (lt ^= nextout);
  593.         call get_row(lt);
  594.         lt = rmod(lt+1);
  595.     end;
  596. end compress_up;
  597.     
  598.         /* diag - display diagnostic message on bottom
  599.                   line of screen */
  600. diag: procedure(string);
  601.     declare
  602.         string character(linelen) varying;
  603.     call cursor_pos(5,scrlen);
  604.     call clear_line;
  605.     call vdu_out(string);
  606. end diag;
  607.     
  608.         /* get_row - get row from input file 
  609.                      into buf_row(row) */
  610. get_row: procedure(row);
  611.     declare
  612.         row,i fixed;
  613.     on endfile(edt_in)
  614.         begin;
  615.         file_end = true;
  616.         buf_row(row) = '';
  617.         goto get_row_exit;
  618.         end;
  619.     if file_end then
  620.         buf_row(row) = '';
  621.     else
  622.         do;
  623.         do while (delrows > 0);
  624.             inrow = inrow+1;
  625.             get file(edt_in) edit(buf_row(row))(a);
  626.             delrows = delrows-1;
  627.         end;
  628.         inrow = inrow+1;
  629.         get file(edt_in) edit(buf_row(row))(a);
  630.         end;
  631.     revert endfile(edt_in);
  632.     get_row_exit: ;
  633. end get_row;
  634.     
  635.         /* input_lines - input keyboard data to crow */
  636. input_lines: procedure;
  637.         input_loop:
  638.         call insert_line;
  639.         call cursor_pos(1,scrlen-2);
  640.         call clear_line;
  641.         call vdu_in(buf_row(crow));
  642.         if length(buf_row(crow)) ^= 0 then
  643.             goto input_loop;
  644.     call compress_up;
  645. end input_lines;
  646.     
  647.         /* insert_line - open up space for input */
  648. insert_line: procedure;
  649.     declare
  650.         (lf, lt) fixed;
  651.     if length(buf_row(crow)) = 0 then
  652.         call cursor_pos(1,scrlen-2);
  653.     else
  654.         if posn < size & length(buf_row(rmod(crow+1))) = 0 then
  655.             call roll_up;
  656.         else
  657.             do;
  658.             call put_row(nextout);
  659.             lt = lastin;
  660.             lf = nextout;
  661.             do while (lf ^= crow);
  662.                 lt = lf;
  663.                 lf = rmod(lf+1);
  664.                 buf_row(lt) = buf_row(lf);
  665.             end;
  666.             buf_row(crow) = '';
  667.             if posn < scrlen-1 then
  668.                 do;
  669.                 call cursor_pos(1,scrlen-1-posn);
  670.                 call clear_line;
  671.                 end;
  672.             call scroll_up;
  673.             end;
  674. end insert_line;
  675.     
  676.         /* line_change - change all occurences string 
  677.                          in line */
  678. line_change: procedure(string, key, subst, error);
  679.     declare
  680.         (string, key, subst) character(linelen) varying,
  681.         (key_len, key_posn, place, str_len) fixed,
  682.         error bit(1);
  683.     place = 1;
  684.     error = false;
  685.     str_len = length(string);
  686.     do while (match(string, place, str_len, key,
  687.                     key_len, key_posn) & ^error);
  688.         call change(string, key_len, key_posn, subst, error);
  689.         place = key_posn + length(subst);
  690.         if length(key) = 0 then
  691.             place = place + 1;
  692.         str_len = length(string);
  693.     end;
  694. end line_change;
  695.     
  696.         /* match - searches string from string(srch_start)
  697.                    to string(srch_end) for a match to key.
  698.                    if found, match starts at string(key_posn)
  699.                    and is key_len long.
  700.                    key string may include ellipsis ('...').*/
  701. match: procedure(string, srch_start, srch_end, key, key_len,
  702.                  key_posn) returns (bit(1));
  703.     declare
  704.         (string, key, zz) character(linelen) varying,
  705.         (srch_start, srch_end, key_len, key_posn, jj) fixed,
  706.         rtn bit(1);
  707.     if srch_start > srch_end then
  708.         do;
  709.         rtn = false;
  710.         return(rtn);
  711.         end;
  712.     if length(key) = 0 then
  713.         do;
  714.         key_len = 0;
  715.         key_posn = srch_start;
  716.         rtn = true;
  717.         end;
  718.     else
  719.         if index(key,'...') = 0 then
  720.             do;   /* no ellipsis in key */
  721.             zz = substr(string, srch_start);
  722.             key_posn = index(zz, key)
  723.                         + srch_start-1;
  724.             if key_posn >= srch_start & 
  725.                key_posn <= srch_end then
  726.                 do;
  727.                 key_len = length(key);
  728.                 rtn = true;
  729.                 end;
  730.             else
  731.                 rtn = false;
  732.             end;
  733.         else
  734.             begin;  /* ellipsis in key */
  735.             declare
  736.                 (key_front, key_back) character (linelen)
  737.                                       varying,
  738.                 i fixed;
  739.             i = index(key,'...');
  740.             key_front = substr(key, 1, i-1);
  741.             key_back  = substr(key, i+3);
  742.             if length(key_front) = 0 then
  743.                 if length(key_back) = 0 then
  744.                     do;
  745.                     key_posn = srch_start;
  746.                     zz = substr(string, srch_start);
  747.                     key_len = length(zz);
  748.                     rtn = true;
  749.                     end;
  750.                 else
  751.                     do;
  752.                     key_posn = srch_start;
  753.                     zz = substr(string, srch_start);
  754.                     i = index(zz, key_back);
  755.                     if i > 0 then
  756.                         do;
  757.                         key_len = i-1+length(key_back);
  758.                         rtn = true;
  759.                         end;
  760.                     else
  761.                         rtn = false;
  762.                     end;
  763.             else
  764.                 do;
  765.                 zz = substr(string, srch_start);
  766.                 key_posn = index(zz,
  767.                                  key_front) + srch_start-1;
  768.                 if key_posn >= srch_start &
  769.                    key_posn <= srch_end then
  770.                     if length(key_back) = 0 then
  771.                         do;
  772.                         zz = substr(string, key_posn);
  773.                         key_len = length(zz);
  774.                         rtn = true;
  775.                         end;
  776.                     else
  777.                         do;
  778.                         jj = length(key_front);
  779.                         zz = substr(string, key_posn + jj); 
  780.                         i = index(zz, key_back);
  781.                         if i > 0 then
  782.                             do;
  783.                             key_len = length(key_front) +
  784.                                       length(key_back) +
  785.                                       i - 1;
  786.                             rtn = true;
  787.                             end;
  788.                         else
  789.                             rtn = false;
  790.                         end;
  791.                 else
  792.                     rtn = false;
  793.                 end;
  794.             end;
  795.     return(rtn);
  796. end match;
  797.     
  798.         /* put_row - write row to edt_out */
  799. put_row: procedure(row);
  800.     declare
  801.         row fixed;
  802.     if length(buf_row(row)) ^= 0 then
  803.         do;
  804.         put file(edt_out) edit(buf_row(row))(a);
  805.         put file(edt_out) skip;
  806.         end;
  807. end put_row;
  808.     
  809.         /* roll_down - roll down screen */
  810. roll_down: procedure;
  811.     if posn > 1 then
  812.         do;
  813.         posn = posn - 1;
  814.         crow = rmod(crow-1);
  815.         call scroll_down;
  816.         if posn > scrlen-2 then
  817.             call spray(1,1);
  818.         call cursor_pos(1,scrlen-1);
  819.         call clear_screen;
  820.         end;
  821. end roll_down;
  822.     
  823.         /* roll_up - roll screen up */
  824. roll_up: procedure;
  825.     if posn = size then
  826.         call swap;
  827.     if posn < size then
  828.         do;
  829.         call scroll_up;
  830.         posn = posn + 1;
  831.         crow = rmod(crow+1);
  832.         end;
  833.     call spray(scrlen-2,scrlen-2);
  834. end roll_up;
  835.     
  836.         /* rmod - modulus function to force row address
  837.                   into range 1 to size */
  838. rmod: procedure(arg) returns (fixed);
  839.     declare
  840.         (arg, rtn) fixed;
  841.     if arg > size then
  842.         rtn = arg - size;
  843.     else if arg < 1 then
  844.         rtn = arg + size;
  845.     else
  846.         rtn = arg;
  847.     return(rtn);
  848. end rmod;
  849.     
  850.         /* split_string - take string in form
  851.                           /..key../..subst../ and split
  852.                           into key and substitute strings */
  853. split_string: procedure(string, key, subst);
  854.     declare
  855.         (string, key, subst) character(linelen) varying,
  856.         (i,j) fixed;
  857.     if length(string) = 0 then
  858.         do;
  859.         key = '';
  860.         subst = '';
  861.         end;
  862.     else
  863.         do;
  864.         i = index(substr(string,2), substr(string,1,1));
  865.         if i = 0 then
  866.             do;
  867.             key = substr(string,2);
  868.             subst = '';
  869.             end;
  870.         else
  871.             do;
  872.             key = substr(string,2,i-1);
  873.             j = i + 2;
  874.             i = index(substr(string,j), substr(string,1,1));
  875.             if i = 0 then
  876.                 subst = substr(string,j);
  877.             else
  878.                 subst = substr(string,j,i-1);
  879.             end;
  880.         end;
  881. end split_string;
  882.     
  883.         /* spray - display screen lines sb to se */
  884. spray: procedure(sb,se);
  885.     declare
  886.         (sb, se, line, row) fixed;
  887.     do line = sb to se;
  888.         call cursor_pos(1,line);
  889.         call clear_line();
  890.         row = rmod(crow - scrlen+2 + line);
  891.         call vdu_out(buf_row(row));
  892.     end;
  893. end spray;
  894.     
  895.         /* swap - output from nextout, input to lastin,
  896.                   adjust pointers */
  897. swap: procedure;
  898.     if length(buf_row(lastin)) ^= 0 then
  899.         do;
  900.         call put_row(nextout);
  901.         lastin = nextout;
  902.         nextout = rmod(nextout+1);
  903.         posn = posn -1;
  904.         end;
  905.     call get_row(lastin);
  906. end swap;
  907.     
  908. /*******************************************************/
  909. /*******************************************************/
  910. /*                                                     */
  911. /*        VDU SUPPORT ROUTINES FOR ICE                 */
  912. /*                                                     */
  913. /*******************************************************/
  914.          
  915.         /* clear line from cursor */
  916. clear_line : procedure;
  917.     call vdu_out('^O');
  918. end clear_line;
  919.      
  920.         /* clear screen from cursor */
  921. clear_screen: procedure;
  922.     call vdu_out('^K');
  923. end clear_screen;
  924.         
  925.         /* cursor position */
  926. cursor_pos: procedure(col,row);
  927.     declare
  928.         str character(linelen) varying,
  929.         i fixed,
  930.         (col, row) fixed;
  931.     scr_row = row;
  932.     scr_col = col;
  933.     if row = 1 then
  934.         do;
  935.         call vdu_out('^N');  /* home cursor */
  936.         put skip;
  937.         call vdu_out('^N');  /* cursor home */
  938.         end;
  939.     else
  940.         do;
  941.         call vdu_out(ascii(escape)!!ascii(2)!!ascii(row+30));
  942.         put skip;
  943.         end;
  944.     if col ^= 1 then
  945.         do;
  946.         str = '';
  947.         i = 1;
  948.         do while (i<col);
  949.             str = str !! '^S';        /* cursor right */
  950.             i = i+1;
  951.         end;
  952.         call vdu_out(str);
  953.         end;
  954. end cursor_pos;
  955.         
  956.         /* home cursor */
  957. home_cursor: procedure;
  958.     call cursor_pos(1,1);
  959. end home_cursor;
  960.         
  961.         /* scroll down */
  962. scroll_down: procedure;
  963.     call vdu_out('^D');
  964. end scroll_down;
  965.         
  966.         /* scroll up */
  967. scroll_up: procedure;
  968.     call vdu_out('^B');
  969. end scroll_up;
  970.         
  971.         /* input from vdu */
  972. vdu_in: procedure(data);
  973.     declare 
  974.         data character(linelen) varying;
  975.     get edit(data) (a);
  976. end vdu_in;
  977.         
  978.         /* output to vdu */
  979. vdu_out: procedure(data);
  980.     declare
  981.         data character(linelen) varying;
  982.     put edit(data) (a);
  983. end vdu_out;
  984.         
  985. /*****************************************************/
  986.         
  987.  
  988. end ice;
  989.