/********************************************************/ /* */ /* EDIT FILE */ /* */ /********************************************************/ edit_file: procedure; declare done bit(1), /* true = return to main proc. */ (cc1, cc2, cc3, cc4) character(1), /* command chars. */ (cmdbuf, /* complete command buffer */ oprnd, /* command buffer less command */ cmdsave, /* complete command buffer save for same command */ locsave) /* complete command buffer save for more command */ character(linelen) varying, number fixed; /* number following command */ done = false; do while (^done); call get_command; call execute_command; end; if ^abort then begin; /* move remainder of edit file to output file */ declare row fixed; row = nextout; drain_buf: call put_row(row); row = rmod(row+1); if row ^= nextout then goto drain_buf; do while (^file_end); call get_row(row); call put_row(row); end; end; /********************************************************/ /* */ /* GET COMMAND LINE */ /* */ /********************************************************/ get_command: procedure; call cursor_pos(1,scrlen-1); call vdu_out('*'); call vdu_in(cmdbuf); call cursor_pos(1,scrlen-1); call clear_screen; if length(cmdbuf) = 1 then begin; declare (ch, zz) character(1); zz = substr(cmdbuf, 1, 1); ch = translate(zz, lower, upper); if ch = 's' then cmdbuf = cmdsave; /* same command */ if ch = 'm' then cmdbuf = locsave; /* more command */ end; /* extract command characters */ cc1 = ' '; cc2 = ' '; cc3 = ' '; cc4 = ' '; declare (i, j) fixed; if length(cmdbuf) = 0 then i = 1; else do; do i = 1 to length(cmdbuf) while (verify(translate(substr(cmdbuf,i,1),lower,upper), lower) = 0); substr(cmdbuf,i,1) = translate(substr(cmdbuf,i,1), lower, upper); end; do j = 1 to length(cmdbuf) while (j<=4); if j = 1 then cc1 = substr(cmdbuf,1,1); if j = 2 then cc2 = substr(cmdbuf,2,1); if j = 3 then cc3 = substr(cmdbuf,3,1); if j = 4 then cc4 = substr(cmdbuf,4,1); end; end; if i <= length(cmdbuf) then if substr(cmdbuf,i,1) = ' ' then i = i+1; /* remove space following command */ number = 0; /* convert number following command */ if i <= length(cmdbuf) then if substr(cmdbuf,i,1) = '*' then number = huge; else begin; declare ch character(1); do j = i to length(cmdbuf) while (verify(substr(cmdbuf,j,1), digit) = 0); ch = substr(cmdbuf,j,1); number = number * 10 + rank(ch) - rank('0'); end; end; if number <= 0 then number = 1; oprnd = substr(cmdbuf, i); end get_command; /*******************************************************/ /*******************************************************/ /* */ /* EXECUTE COMMAND */ /* */ /*******************************************************/ execute_command: procedure; declare error bit(1); /* true = line would be trancated */ error = false; if cc1 = 'a' then call ex_append; else if cc1 = 'c' then call ex_change; else if cc1 = 'd' then call ex_delete; else if cc1 = 'f' then call ex_find; else if cc1 = 'i' then call ex_insert; else if cc1 = 'l' then if cc2 = 'c' then call ex_line_change; else if cc2 = 'e' then call ex_length; else call ex_locate; else if cc1 = 'm' & cc2 = 'o' then call ex_modify; else if cc1 = 'n' then if cc2 = 'p' then call ex_number_plus; else call ex_number; else if cc1 = 'o' then call ex_overtype; else if cc1 = 'p' then if cc2 = 'a' then call ex_paste; else if cc2 = '-' then call ex_page_down; else call ex_page_up; else if cc1 = 'q' then call ex_quit; else if cc1 = 'r' then call ex_replace; else if cc1 = 'w' then call ex_write; else if cc1 = '-' then call ex_line_down; else if cc1 = ' ' then call ex_line_up; else call diag('illegal command'); if error then call diag('line would be too long'); if posn = size & file_end & length(buf_row(crow)) = 0 & ^done then if inopen then call diag('end of file'); else call diag('no input file open'); if rmod(lastin+1) ^= nextout then /* problem */ do; call diag('help - lastin error'); done = true; abort = true; end; if rmod(crow-lastin) ^= posn then /* problem */ do; call diag('help - posn error'); done = true; abort = true; end; /********************************************************/ /* */ /* COMMAND EXECUTORS */ /* */ /********************************************************/ /* A - append operand to current line */ ex_append: procedure; cmdsave = cmdbuf; if length(oprnd) + length(buf_row(crow)) > linelen then error = true; else do; buf_row(crow) = buf_row(crow) !! oprnd; call spray(scrlen-2, scrlen-2); end; end ex_append; /* C - change 1st. occurence of string in current line */ ex_change: procedure; cmdsave = cmdbuf; declare (key, subst) character (linelen) varying, (key_len, key_posn, i) fixed; call split_string(oprnd, key, subst); i = length(buf_row(crow)); if match(buf_row(crow), 1, i, key, key_len, key_posn) then do; call change(buf_row(crow), key_len, key_posn, subst, error); call spray(scrlen-2, scrlen-2); end; else call diag('no match'); end ex_change; /* D - delete n lines including current line */ ex_delete: procedure; delrows = number; call blank; call compress_up; call spray(scrlen-2, scrlen-2); end ex_delete; /* F - find next line containing operand in column 1 */ ex_find: procedure; locsave = cmdbuf; declare (junk1, junk2) fixed; find_loop: if crow = lastin then call swap; crow = rmod(crow+1); if ^(match(buf_row(crow), 1, 1, oprnd, junk1, junk2) ! (file_end & crow = lastin)) then goto find_loop; posn = rmod(crow - lastin); call spray(1, scrlen-2); end ex_find; /* I - insert lines or operand of command */ ex_insert: procedure; if length(oprnd) = 0 then do; call input_lines; call spray(scrlen-2, scrlen-2); end; else do; cmdsave = cmdbuf; call insert_line; buf_row(crow) = oprnd; call spray(scrlen-2, scrlen-2); end; end ex_insert; /* LE - length of line */ ex_length: procedure; call diag(character(length(buf_row(crow))) !! ' chars'); end ex_length; /* LC - change all occurrences of string in current line */ ex_line_change: procedure; cmdsave = cmdbuf; declare (key, subst) character (linelen) varying, (junk1, junk2, i) fixed; call split_string(oprnd, key, subst); i = length(buf_row(crow)); if match(buf_row(crow), 1, i, key, junk1, junk2) then do; call line_change(buf_row(crow), key, subst, error); call spray(scrlen-2, scrlen-2); end; else call diag('no match'); end ex_line_change; /* L - locate next line containing operand */ ex_locate: procedure; locsave = cmdbuf; declare (junk1, junk2, i) fixed; locate_loop: if crow = lastin then call swap; crow = rmod(crow+1); i = length(buf_row(crow)); if ^(match(buf_row(crow),1,i, oprnd, junk1, junk2) ! (file_end & crow = lastin)) then goto locate_loop; posn = rmod(crow-lastin); call spray(1,scrlen-2); end ex_locate; /* MO - modify line */ ex_modify: procedure; call diag('not yet implemented'); end ex_modify; /* N - goto nominated line */ ex_number: procedure; declare row fixed; row = number; if row < inrow-size+1 then call diag('already past'); else if row > inrow+scrlen-2 then do; do while(^(inrow = row ! file_end)); call swap; end; crow = lastin; posn = size; call spray(1,scrlen-2); end; else do; do while((row > inrow-size+posn) & ^(posn = size & file_end)); call roll_up; end; do while(row < inrow-size+posn); call roll_down; end; end; end ex_number; /* NP - goto n lines past current line */ ex_number_plus: procedure; locsave = cmdbuf; declare row fixed; row = number+inrow-size+posn; if row > inrow+scrlen-2 then do; do while(^(inrow = row ! file_end)); call swap; end; crow = lastin; posn = size; call spray(1,scrlen-2); end; else do; do while((row > inrow-size+posn) & ^(posn = size & file_end)); call roll_up; end; end; end ex_number_plus; /* O - overtype -- delete n lines and input from vdu */ ex_overtype: procedure; delrows = number; call blank; call input_lines; call spray(scrlen-2, scrlen-2); end ex_overtype; /* P - roll up one or more pages */ ex_page_up: procedure; declare i fixed; do i = 1 to (scrlen-3)*number while(^(posn = size & file_end)); call roll_up; end; end ex_page_up; /* P- -- roll down one page */ ex_page_down: procedure; declare i fixed; do i = 1 to (scrlen-3); call roll_down; end; end ex_page_down; /* PA - paste -- change all occurences of string until eof */ ex_paste: procedure; cmdsave = cmdbuf; declare (key, subst) character (linelen) varying, (junk1, junk2, i) fixed; call split_string(oprnd, key, subst); do while(^(posn = size & file_end) & ^error); i = length(buf_row(crow)); if match(buf_row(crow), 1, i, key, junk1, junk2) then do; call line_change(buf_row(crow), key, subst, error); call scroll_up; call spray(scrlen-2, scrlen-2); end; if ^error then do; if crow = lastin then call swap; crow = rmod(crow+1); posn = rmod(crow-lastin); end; end; end ex_paste; /* Q - quit -- no change to file */ ex_quit: procedure; abort = true; done = true; end ex_quit; /* R - replace current line with operand */ ex_replace: procedure; cmdsave = cmdbuf; buf_row(crow) = oprnd; call compress_up; call spray(scrlen-2, scrlen-2); end ex_replace; /* W - write file -- end edit */ ex_write: procedure; done = true; end ex_write; /* - -- roll down 1 line */ ex_line_down: procedure; call roll_down; end ex_line_down; /* return - roll up one line */ ex_line_up: procedure; call roll_up; end ex_line_up; end execute_command; /********************************************************/ end edit_file; /********************************************************/