home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / sigmv083.ark / ICE-EDIT.PLI < prev    next >
Encoding:
Text File  |  1984-04-29  |  12.7 KB  |  426 lines
  1. /********************************************************/
  2. /*                                                      */
  3. /*             EDIT FILE                                */
  4. /*                                                      */
  5. /********************************************************/
  6.   
  7. edit_file: procedure;
  8.     declare
  9.         done        bit(1),   /* true = return to main proc. */
  10.         (cc1, cc2, cc3, cc4) character(1), /* command chars. */
  11.         (cmdbuf,              /* complete command buffer */
  12.          oprnd,               /* command buffer less command */
  13.          cmdsave,             /* complete command buffer
  14.                                  save for same command */
  15.          locsave)             /* complete command buffer
  16.                                  save for more command */
  17.                     character(linelen) varying,
  18.         number      fixed;    /* number following command */
  19.     done = false;
  20.     do while (^done);
  21.         call get_command;
  22.         call execute_command;
  23.     end;
  24.     if ^abort then
  25.         begin; /* move remainder of edit file to output file */
  26.         declare
  27.             row fixed;
  28.         row = nextout;
  29.             drain_buf:
  30.             call put_row(row);
  31.             row = rmod(row+1);
  32.             if row ^= nextout then goto drain_buf;
  33.         do while (^file_end);
  34.             call get_row(row);
  35.             call put_row(row);
  36.         end;
  37.         end;
  38.             
  39. /********************************************************/
  40. /*                                                      */
  41. /*                GET COMMAND LINE                      */
  42. /*                                                      */
  43. /********************************************************/
  44.   
  45. get_command: procedure;
  46.     call cursor_pos(1,scrlen-1);
  47.     call vdu_out('*');
  48.     call vdu_in(cmdbuf);
  49.     call cursor_pos(1,scrlen-1);
  50.     call clear_screen;
  51.     if length(cmdbuf) = 1 then
  52.         begin;
  53.         declare
  54.             (ch, zz) character(1);
  55.         zz = substr(cmdbuf, 1, 1);
  56.         ch = translate(zz, lower, upper);
  57.         if ch = 's' then
  58.             cmdbuf = cmdsave;  /* same command */
  59.         if ch = 'm' then
  60.             cmdbuf = locsave;  /* more command */
  61.         end;
  62.     /* extract command characters */
  63.     cc1 = ' ';  cc2 = ' ';  cc3 = ' ';  cc4 = ' ';
  64.     declare
  65.         (i, j) fixed;
  66.     if length(cmdbuf) = 0 then
  67.         i = 1;
  68.     else
  69.         do;
  70.         do i = 1 to length(cmdbuf)
  71.         while (verify(translate(substr(cmdbuf,i,1),lower,upper),
  72.                      lower) = 0);
  73.             substr(cmdbuf,i,1) = translate(substr(cmdbuf,i,1),
  74.                                            lower, upper);
  75.         end;
  76.         do j = 1 to length(cmdbuf) while (j<=4);
  77.             if j = 1 then cc1 = substr(cmdbuf,1,1);
  78.             if j = 2 then cc2 = substr(cmdbuf,2,1);
  79.             if j = 3 then cc3 = substr(cmdbuf,3,1);
  80.             if j = 4 then cc4 = substr(cmdbuf,4,1);
  81.         end;
  82.     end;
  83.     if i <= length(cmdbuf) then
  84.         if substr(cmdbuf,i,1) = ' ' then
  85.             i = i+1;  /* remove space following command */
  86.     number = 0;  /* convert number following command */
  87.     if i <= length(cmdbuf) then
  88.         if substr(cmdbuf,i,1) = '*' then
  89.             number = huge;
  90.         else
  91.             begin;
  92.             declare
  93.                 ch character(1);
  94.             do j = i to length(cmdbuf)
  95.                 while (verify(substr(cmdbuf,j,1), digit) = 0);
  96.                 ch = substr(cmdbuf,j,1);
  97.                 number = number * 10 +
  98.                          rank(ch) - rank('0');
  99.             end;
  100.             end;
  101.     if number <= 0 then
  102.         number = 1;
  103.     oprnd = substr(cmdbuf, i);
  104. end get_command;
  105.   
  106. /*******************************************************/
  107.   
  108. /*******************************************************/
  109. /*                                                     */
  110. /*              EXECUTE COMMAND                        */
  111. /*                                                     */
  112. /*******************************************************/
  113.   
  114. execute_command: procedure;
  115.     declare
  116.         error bit(1);    /* true = line would be trancated */
  117.     error = false;
  118.          if cc1 = 'a' then call ex_append;
  119.     else if cc1 = 'c' then call ex_change;
  120.     else if cc1 = 'd' then call ex_delete;
  121.     else if cc1 = 'f' then call ex_find;
  122.     else if cc1 = 'i' then call ex_insert;
  123.     else if cc1 = 'l' then
  124.              if cc2 = 'c' then call ex_line_change;
  125.              else if cc2 = 'e' then call ex_length;
  126.              else call ex_locate;
  127.     else if cc1 = 'm' & cc2 = 'o' then call ex_modify;
  128.     else if cc1 = 'n' then
  129.              if cc2 = 'p' then call ex_number_plus;
  130.              else call ex_number;
  131.     else if cc1 = 'o' then call ex_overtype;
  132.     else if cc1 = 'p' then
  133.              if cc2 = 'a' then call ex_paste;
  134.              else if cc2 = '-' then call ex_page_down;
  135.              else call ex_page_up;
  136.     else if cc1 = 'q' then call ex_quit;
  137.     else if cc1 = 'r' then call ex_replace;
  138.     else if cc1 = 'w' then call ex_write;
  139.     else if cc1 = '-' then call ex_line_down;
  140.     else if cc1 = ' ' then call ex_line_up;
  141.     else call diag('illegal command');
  142.     if error then
  143.         call diag('line would be too long');
  144.     if posn = size & file_end &
  145.        length(buf_row(crow)) = 0 & ^done then
  146.         if inopen then
  147.             call diag('end of file');
  148.         else
  149.             call diag('no input file open');
  150.     if rmod(lastin+1) ^= nextout then   /* problem */
  151.         do;
  152.         call diag('help - lastin error');
  153.         done = true;
  154.         abort = true;
  155.         end;
  156.     if rmod(crow-lastin) ^= posn then   /* problem */
  157.         do;
  158.         call diag('help - posn error');
  159.         done = true;
  160.         abort = true;
  161.         end;
  162.   
  163. /********************************************************/
  164. /*                                                      */
  165. /*             COMMAND EXECUTORS                        */
  166. /*                                                      */
  167. /********************************************************/
  168.   
  169. /* A - append operand to current line */
  170. ex_append: procedure;
  171.     cmdsave = cmdbuf;
  172.     if length(oprnd) + length(buf_row(crow)) > linelen then
  173.         error = true;
  174.     else
  175.         do;
  176.         buf_row(crow) = buf_row(crow) !! oprnd;
  177.         call spray(scrlen-2, scrlen-2);
  178.         end;
  179. end ex_append;
  180.   
  181. /* C - change 1st. occurence of string in current line */
  182. ex_change: procedure;
  183.     cmdsave = cmdbuf;
  184.     declare
  185.         (key, subst) character (linelen) varying,
  186.         (key_len, key_posn, i) fixed;
  187.     call split_string(oprnd, key, subst);
  188.     i = length(buf_row(crow));
  189.     if match(buf_row(crow), 1, i,
  190.              key, key_len, key_posn) then
  191.         do;
  192.         call change(buf_row(crow), key_len, key_posn,
  193.                     subst, error);
  194.         call spray(scrlen-2, scrlen-2);
  195.         end;
  196.     else
  197.         call diag('no match');
  198. end ex_change;
  199.   
  200. /* D - delete n lines including current line */
  201. ex_delete: procedure;
  202.     delrows = number;
  203.     call blank;
  204.     call compress_up;
  205.     call spray(scrlen-2, scrlen-2);
  206. end ex_delete;
  207.   
  208. /* F - find next line containing operand in column 1 */
  209. ex_find: procedure;
  210.     locsave = cmdbuf;
  211.     declare
  212.         (junk1, junk2) fixed;
  213.         find_loop:
  214.         if crow = lastin then call swap;
  215.         crow = rmod(crow+1);
  216.         if ^(match(buf_row(crow), 1, 1, oprnd, junk1, junk2) !
  217.             (file_end & crow = lastin)) then goto find_loop;
  218.     posn = rmod(crow - lastin);
  219.     call spray(1, scrlen-2);
  220. end ex_find;
  221.   
  222. /* I - insert lines or operand of command */
  223. ex_insert: procedure;
  224.     if length(oprnd) = 0 then
  225.         do;
  226.         call input_lines;
  227.         call spray(scrlen-2, scrlen-2);
  228.         end;
  229.     else
  230.         do;
  231.         cmdsave = cmdbuf;
  232.         call insert_line;
  233.         buf_row(crow) = oprnd;
  234.         call spray(scrlen-2, scrlen-2);
  235.         end;
  236. end ex_insert;
  237.   
  238. /* LE - length of line */
  239. ex_length: procedure;
  240.     call diag(character(length(buf_row(crow))) !! ' chars');
  241. end ex_length;
  242.   
  243. /* LC - change all occurrences of string in current line */
  244. ex_line_change: procedure;
  245.     cmdsave = cmdbuf;
  246.     declare
  247.         (key, subst) character (linelen) varying,
  248.         (junk1, junk2, i) fixed;
  249.     call split_string(oprnd, key, subst);
  250.     i = length(buf_row(crow));
  251.     if match(buf_row(crow), 1, i,
  252.              key, junk1, junk2) then
  253.         do;
  254.         call line_change(buf_row(crow), key, subst, error);
  255.         call spray(scrlen-2, scrlen-2);
  256.         end;
  257.     else
  258.         call diag('no match');
  259. end ex_line_change;
  260.   
  261. /* L - locate next line containing operand */
  262. ex_locate: procedure;
  263.     locsave = cmdbuf;
  264.     declare
  265.         (junk1, junk2, i) fixed;
  266.         locate_loop:
  267.         if crow = lastin then
  268.             call swap;
  269.         crow = rmod(crow+1);
  270.         i = length(buf_row(crow));
  271.         if ^(match(buf_row(crow),1,i,
  272.                    oprnd, junk1, junk2) !
  273.              (file_end & crow = lastin)) then goto locate_loop;
  274.     posn = rmod(crow-lastin);
  275.     call spray(1,scrlen-2);
  276. end ex_locate;
  277.   
  278. /* MO - modify line */
  279. ex_modify: procedure;
  280.     call diag('not yet implemented');
  281. end ex_modify;
  282.   
  283. /* N - goto nominated line */
  284. ex_number: procedure;
  285.     declare
  286.         row fixed;
  287.     row = number;
  288.     if row < inrow-size+1 then
  289.         call diag('already past');
  290.     else
  291.         if row > inrow+scrlen-2 then
  292.             do;
  293.             do while(^(inrow = row ! file_end));
  294.                 call swap;
  295.             end;
  296.             crow = lastin;
  297.             posn = size;
  298.             call spray(1,scrlen-2);
  299.             end;
  300.         else
  301.             do;
  302.             do while((row > inrow-size+posn) & 
  303.                      ^(posn = size & file_end));
  304.                 call roll_up;
  305.             end;
  306.             do while(row < inrow-size+posn);
  307.                 call roll_down;
  308.             end;
  309.             end;
  310. end ex_number;
  311.   
  312. /* NP - goto n lines past current line */
  313. ex_number_plus: procedure;
  314.     locsave = cmdbuf;
  315.     declare
  316.         row fixed;
  317.     row = number+inrow-size+posn;
  318.     if row > inrow+scrlen-2 then
  319.         do;
  320.         do while(^(inrow = row ! file_end));
  321.             call swap;
  322.         end;
  323.         crow = lastin;
  324.         posn = size;
  325.         call spray(1,scrlen-2);
  326.         end;
  327.     else
  328.         do;
  329.         do while((row > inrow-size+posn) & 
  330.                  ^(posn = size & file_end));
  331.             call roll_up;
  332.         end;
  333.         end;
  334. end ex_number_plus;
  335.   
  336. /* O - overtype -- delete n lines and input from vdu */
  337. ex_overtype: procedure;
  338.     delrows = number;
  339.     call blank;
  340.     call input_lines;
  341.     call spray(scrlen-2, scrlen-2);
  342. end ex_overtype;
  343.   
  344. /* P - roll up one or more pages */
  345. ex_page_up: procedure;
  346.     declare
  347.         i fixed;
  348.     do i = 1 to (scrlen-3)*number while(^(posn = size &
  349.                                           file_end));
  350.         call roll_up;
  351.     end;
  352. end ex_page_up;
  353.   
  354. /* P- -- roll down one page */
  355. ex_page_down: procedure;
  356.     declare
  357.         i fixed;
  358.     do i = 1 to (scrlen-3);
  359.         call roll_down;
  360.     end;
  361. end ex_page_down;
  362.   
  363. /* PA - paste -- change all occurences of string until eof */
  364. ex_paste: procedure;
  365.     cmdsave = cmdbuf;
  366.     declare
  367.         (key, subst) character (linelen) varying,
  368.         (junk1, junk2, i) fixed;
  369.     call split_string(oprnd, key, subst);
  370.     do while(^(posn = size & file_end) & ^error);
  371.         i = length(buf_row(crow));
  372.         if match(buf_row(crow), 1, i,
  373.                  key, junk1, junk2) then
  374.             do;
  375.             call line_change(buf_row(crow), key, subst, error);
  376.             call scroll_up;
  377.             call spray(scrlen-2, scrlen-2);
  378.             end;
  379.         if ^error then
  380.             do;
  381.             if crow = lastin then
  382.                 call swap;
  383.             crow = rmod(crow+1);
  384.             posn = rmod(crow-lastin);
  385.             end;
  386.     end;
  387. end ex_paste;
  388.   
  389. /* Q - quit -- no change to file */
  390. ex_quit: procedure;
  391.     abort = true;
  392.     done = true;
  393. end ex_quit;
  394.   
  395. /* R - replace current line with operand */
  396. ex_replace: procedure;
  397.     cmdsave = cmdbuf;
  398.     buf_row(crow) = oprnd;
  399.     call compress_up;
  400.     call spray(scrlen-2, scrlen-2);
  401. end ex_replace;
  402.   
  403. /* W - write file -- end edit */
  404. ex_write: procedure;
  405.     done = true;
  406. end ex_write;
  407.   
  408. /* - -- roll down 1 line */
  409. ex_line_down: procedure;
  410.     call roll_down;
  411. end ex_line_down;
  412.   
  413. /* return - roll up one line */
  414. ex_line_up: procedure;
  415.     call roll_up;
  416. end ex_line_up;
  417.   
  418. end execute_command;
  419.   
  420. /********************************************************/
  421.   
  422. end edit_file;
  423.   
  424. /********************************************************/
  425.   
  426.