/* get a command interactively for PL/I symbolic debugger allows editing via left & right arrows and delete, anything else is inserted */ edit_command: procedure; %include 'scandef.pli'; %include 'tiqio.inc'; %include 'putdef.pli'; /* note- wrtpas is used instead of PUT because PL/I PUT can not recognize the escape sequences as cursor manipulations and will insert unwanted cr's thinking the length of the output line is > 80 char */ dcl wrtpas entry( file, char(*) ), ascii entry(fixed bin(7)) returns(char(1)), iand entry(fixed bin(15), fixed bin(15)) returns(fixed bin(15)); /* ascii characters: */ dcl bell fixed bin(7) static initial('007'b3), backspace fixed bin(7) static initial('010'b3), delete fixed bin(7) static initial('177'b3), escape fixed bin(7) static initial('033'b3), carriage_return fixed bin(7) static initial('015'b3), control_C fixed bin(7) static initial('003'b3), control_R fixed bin(7) static initial('022'b3), control_U fixed bin(7) static initial('025'b3), control_W fixed bin(7) static initial('027'b3), control_Z fixed bin(7) static initial('032'b3); /* VT100 escape sequences: */ /*note that we take advantage of the fact that in string(struct) AIS-PL/I does not convert non-character items*/ dcl 1 blankline, 2 a fixed bin(7) initial ('033'b3), 2 b char(2) initial('[K'); dcl 1 save_cursor_attr static, 2 a fixed bin(7) initial ('033'b3), 2 b char(1) initial('7'); dcl 1 restore_cursor_attr static, 2 a fixed bin(7) initial ('033'b3), 2 b char(1) initial('8'); dcl 1 turn_off_attr static, 2 a fixed bin(7) initial ('033'b3), 2 b char(3) initial('[0m'); dcl (read_char /*read pass all and no echo*/, sf_smc /*set characteristics*/) fixed bin (15) external /*qio function codes defined in debasm*/, flush_typeahead_buffer fixed bin(15) external /*set characteristics code defined in debasm*/, no_error fixed bin(15) external; dcl typed_char char(1) static /*static for memory efficiency*/, typed_char_addr pointer initial(addr(typed_char)), typed_char_byte fixed bin(7) based(typed_char_addr), editline char(80) nonvarying static /*static for memory efficiency*/, control_char_entered fixed bin(1) static initial(0/*false*/), (column, mincolumn, maxcolumn) fixed bin (15), (err, i) fixed bin(15); if false then put skip;/**temp for pli bug-must implicitly declare sysprint*/ /**************************************************************************************************************/ /* The normal escape sequence for cursor movement causes the cursor to move one space if the distance parameter is < 1. This routine, however, defaults to no movement. Only called for VT100s. */ dcl ( left initial(0), right initial(1) ) fixed bin(1) static; move: procedure(direction, dist); dcl direction fixed bin(1) /* right or left */, dist fixed bin(15) /* Distance (# characters) to move */; dcl 1 how_far static, 2 a fixed bin(7) initial('033'b3), 2 b char(1) initial('['), 2 distance char(2); dcl charz entry(fixed bin(31), fixed bin(15)) returns(char(13) varying); if dist > 0 then do; distance = charz(dist, 2); call wrtpas(sysprint, string(how_far)); if direction = right then call wrtpas(sysprint, 'C'); else if direction = left then call wrtpas(sysprint, 'D'); end; end move; /* start a new line */ newline: procedure; /**temp add for PL/I bug:***********************/ dcl 1 blankline, 2 a fixed bin(7) initial ('033'b3), 2 b char(2) initial('[K'); /*************************/ call wrtpas(sysprint, ascii(carriage_return)); if VT100 then call wrtpas(sysprint, string(blankline)); /*VT100 - can clear line in place*/ else call put_skip; /*otherwise assume hard copy device - go to another line*/ end; /* PL/I symbolic debugger procedure to type a string, showing control chars as their corresponding graphics characters or as a '~' if none exists. Type_string is not used for two reasons 1) wrtpas must be used to keep unwanted carriage returns away and 2) the control_character switch allows better performance when there are no control characters in the line. */ type_commandline: procedure(line, cntrl_char_entered); dcl line char(*), cntrl_char_entered fixed bin(1); dcl c char(1), i fixed bin(15); dcl iand entry(fixed bin(15), fixed bin(15)) returns(fixed bin(15)); dcl printable_char entry(char(1)) returns(char(7) varying); if cntrl_char_entered then do i = 1 to length(line); c = substr(line, i, 1); call wrtpas(sysprint, printable_char(c)); end; else call wrtpas(sysprint, line); end type_commandline; /**************************************************************************************************************/ nextp = 1; /*make sure scanners start at beginning of line*/ mincolumn = length(prompt)+1; if debprocedure_define_level^=0 then mincolumn = mincolumn+2+debprocedure_define_level; /*indent for do-group/debprocedure definition*/ call put_skip; clearline: control_char_entered = false; editline = prompt; maxcolumn = mincolumn-1; column = mincolumn; if VT100 then call wrtpas(sysprint, string(blankline)); call wrtpas(sysprint, substr(editline, 1, maxcolumn)); /*type the prompt*/ getnextchar: call tiqio(read_char, 'read', addr(typed_char_byte), 1, err); typed_char_byte = iand(typed_char_byte, '177'b3); /* strip off parity bit */ if err ^= no_error then do; call tiqio(sf_smc, 'set characteristics', addr(flush_typeahead_buffer), 2, err); goto error_on_read; /*go to a new line & re-echo (tiqio has printed error message)*/ end; /* carriage return - return the line in commandline */ if typed_char_byte = carriage_return then do; call wrtpas(sysprint, ascii(carriage_return)); control_char_in_last_line = control_char_entered; commandline = substr(editline, mincolumn, maxcolumn-mincolumn+1); last_commandline = commandline; return; end; /* control-Z - same as STOP */ if (typed_char_byte = control_Z) then do; call wrtpas(sysprint, '^Z'); commandline = 'STOP'; return; end; /* control-C - same as DCL */ if typed_char_byte = control_C then do; call wrtpas(sysprint, '^C'); commandline = 'DCL'; return; end; /* control-U - cancel everything typed so far */ if typed_char_byte = control_U then do; if ^ VT100 then call wrtpas(sysprint, '^U'); call newline; go to clearline; end; if typed_char_byte = control_R ! typed_char_byte = control_W then do; /* control-W - bring last command back */ if typed_char_byte = control_W then do; substr(editline, mincolumn) = last_commandline; maxcolumn = mincolumn + length(last_commandline) - 1; control_char_entered = control_char_in_last_line; if ^ VT100 then call wrtpas(sysprint, '^U'); end; /* control-R - advance a line & re-type current command*/ else do; call wrtpas(sysprint, '^R'); error_on_read: if VT100 then call put_skip; /*newline does it for non-VT100*/ end; column = maxcolumn + 1; call newline; call type_commandline(substr(editline, 1, maxcolumn), control_char_entered); if (maxcolumn = commandline_size) & VT100 then do; call wrtpas(sysprint, ascii(carriage_return)); call move(right, commandline_size-1); end; end; /* delete - delete a character */ else if typed_char_byte = delete then do; if column = mincolumn then go to getnextchar; maxcolumn = maxcolumn - 1; column = column - 1; substr(editline, column) = substr(editline, column+1); if column < commandline_size then do; /* The special case for at end of line was added so this program could run on non-VT-100 terminals */ if column = maxcolumn + 1 /* ie. at end of line */ then do; call wrtpas(sysprint, ascii(backspace)); call wrtpas(sysprint, ' '); call wrtpas(sysprint, ascii(backspace)); end; else do; call wrtpas(sysprint, ascii(backspace)); call wrtpas(sysprint, string(blankline)); call type_commandline(substr(editline, column, maxcolumn+1-column), control_char_entered); call move(left, maxcolumn+1-column); end; end; else do; call wrtpas(sysprint, ' '); if VT100 then do; call wrtpas(sysprint, ascii(carriage_return)); call move(right, commandline_size-1); end; end; end; /* escape - handle left & right arrow keys */ else if (typed_char_byte = escape) & VT100 then do; call tiqio(read_char, 'read', addr(typed_char_byte), 1, err); if typed_char ^= '[' then go to unrecognized_escape_sequence; call tiqio(read_char, 'read', addr(typed_char_byte), 1, err); if typed_char = 'C' then do; /* move cursor to right */ if column >= (maxcolumn+1) then call wrtpas(sysprint, ascii(bell)); else do; if column < commandline_size then call move(right, 1); column = column + 1; end; end; else if typed_char = 'D' then do; /* move cursor to left */ if column > mincolumn then do; if column <= commandline_size then call move(left, 1); column = column - 1; end; else call wrtpas(sysprint, ascii(bell)); end; else go to unrecognized_escape_sequence; end; /* anything else - insert it */ else if column > commandline_size then call wrtpas(sysprint, ascii(bell)); /*line full*/ else do; if typed_char_byte<'20'B4 /*blank*/ then control_char_entered = true; commandline = editline; /*use commandline as a temporary*/ substr(editline, column, 1) = typed_char; substr(editline, column+1) = substr(commandline, column); column = column + 1; if maxcolumn < commandline_size then maxcolumn = maxcolumn +1; call type_commandline(substr(editline, column-1, maxcolumn+2-column), control_char_entered); if VT100 then do; if maxcolumn < commandline_size then call move(left, maxcolumn+1-column); else do; call wrtpas(sysprint, ascii(carriage_return)); if column = commandline_size+1 then call move(right, commandline_size-1); else call move(right, column-1); end; end; end; go to getnextchar; unrecognized_escape_sequence: call tiqio(sf_smc, 'set characteristics', addr(flush_typeahead_buffer), 2, err); call wrtpas(sysprint, ascii(bell)); go to getnextchar; end edit_command;