/*****************************************************************************/ /* set_terminal_type - a program to determine a terminals type */ /* */ /* Original Version: 89-05-04 */ /* Modification History */ /* End of modification history */ /*****************************************************************************/ %options system_programming, no_mapcase; %nolist; /* indent format options */ /*: continuation_offset=8, then_else_indentation=0, right_margin=78, remark_column=46, indentation_offset=5, replace_value_column=36, dcl_attributes_column=36, align_replace_values, align_dcl_attributes, align_dcl_continuation,align_comment_body, fill, embed_remarks, ^space_before_parens */ %list; /* ========================================================================= */ %replace MY_NAME by 'set_terminal_type'; %replace TRUE by '1'b; %replace FALSE by '0'b; %include 'system_io_constants'; %include 'term_control_opcodes'; declare s$error entry(fixed bin(15), char(*) var, char(*) var); declare s$control entry(fixed bin(15), fixed bin(15), fixed bin(15), fixed bin(15)); declare s$set_io_time_limit entry(fixed bin(15), fixed bin(31), fixed bin(15)); declare s$write_raw entry(fixed bin(15), fixed bin(15), char(*), fixed bin(15)); declare s$read_raw entry(fixed bin(15), fixed bin(15), fixed bin(15), char(*), fixed bin(15)); declare s$sleep entry(fixed bin(31), fixed bin(15)); declare s$write entry(char(*) var); declare s$seq_read entry(fixed bin(15), fixed bin(15), fixed bin(15), char(*), fixed bin(15)); declare s$attach_port entry(char(32) var, char(256) var, fixed bin(15), fixed bin(15), fixed bin(15)); declare s$open entry(fixed bin(15), fixed bin(15), fixed bin(15), fixed bin(15), fixed bin(15), fixed bin(15), char(32) var, fixed bin(15)); declare s$stop_program entry (char (*) var, fixed bin (15)); declare (e$end_of_file, e$long_record, e$short_record, e$timeout) fixed binary(15) external; declare 1 stt based, 2 inq char(32), /* query character string */ 2 pref char(32) varying, /* identifiying prefix */ 2 default char(32) varying, /* default term type */ 2 type_off bin(15), /* type location */ 2 type_len bin(15), /* type length */ 2 parms(5), 3 name char(32) varying, /* parameter to display */ 3 offset bin(15), /* parm location */ 3 len bin(15), /* parm length */ 2 cmd char(300) varying; /* cmd to execute for this trm*/ declare s$parse_command entry(char(*) var, bin(15), char(*) var, char(*) var, char(*) var, bin(15), char(*) var, bit(1) aligned, char(*) var, bit(1) aligned, char(*) var); set_terminal_type: procedure; declare (inquiry_request, table_path, terminal_type, terminal_comment, terminal_message) character(256) varying, wait_timer fixed binary(15), ix fixed binary(15), table_port fixed binary(15), bin15_based fixed binary(15) based, no_cmd bit(1) aligned, raw bit(1) aligned, error_code fixed binary(15); declare 1 set_term_type like stt, stt_buf defined set_term_type character(bytesize(stt)); call s$parse_command(MY_NAME, error_code, 'stt:pathname.table,req,=stt.table', table_path, 'option(wait_timer),number,word,=3', wait_timer, 'switch(raw),secret,=0', raw, 'switch(no_cmd),secret,=0', no_cmd, 'end'); if error_code ^= 0 then return; call open_type_table(table_path, table_port, error_code); if error_code ^= 0 then return; call s$seq_read(table_port, bytesize(stt), 0, stt_buf, error_code); if error_code ^= 0 then do; call s$error(error_code, MY_NAME, 'reading term type table - initial read'); return; end; do while (error_code = 0); /* perform an inquiry */ inquiry_request = ltrim(rtrim(set_term_type.inq)); call inquire_terminal(inquiry_request, terminal_message, error_code); if error_code = e$timeout then do; /* the terminal did not respond to this inquiry */ do while (inquiry_request = ltrim(rtrim(set_term_type.inq))); call s$seq_read(table_port, bytesize(stt), 0, stt_buf, error_code); if error_code ^= 0 & error_code ^= e$end_of_file then do; call s$error(error_code, MY_NAME, 'reading term type table - read next'); return; end; /* cannot identify the terminal */ if error_code = e$end_of_file then return; end; end; else if error_code = 0 /* got a response - see if it matches */ then do; if raw then call s$write('response->' || terminal_message); do while ((length(terminal_message) < length(set_term_type.pref) | set_term_type.pref ^= substr(terminal_message, 1, min(length(set_term_type.pref), length(terminal_message)))) & inquiry_request = ltrim(rtrim(set_term_type.inq))); call s$seq_read(table_port, bytesize(stt), 0, stt_buf, error_code); if error_code ^= 0 & error_code ^= e$end_of_file then do; call s$error(error_code, MY_NAME, 'reading term type table - read next'); return; end; /* cannot identify the terminal */ if error_code = e$end_of_file then do; call s$write('unknown: ' || terminal_type); return; end; end; if inquiry_request = ltrim(rtrim(set_term_type.inq)) then do ; /* got a match */ if set_term_type.type_off ^= -1 then terminal_type = substr(terminal_message, set_term_type.type_off, set_term_type.type_len); else terminal_type = set_term_type.default; terminal_comment = 'terminal type: ' || terminal_type || ' '; do ix = 1 to 5; if set_term_type.parms(ix).offset ^= -1 & length(terminal_message) >= set_term_type.parms(ix).offset then do; terminal_comment = terminal_comment || set_term_type.parms(ix).name || substr(terminal_message, set_term_type.parms(ix).offset, min(set_term_type.parms(ix).len, length(terminal_message) - set_term_type.parms(ix).offset)); end; end; call s$control(TERMINAL_PORT_ID, SET_TERMINAL_TYPE_OPCODE, addr(terminal_type) -> bin15_based, error_code); if error_code ^= 0 then do; call s$error(error_code, MY_NAME, 'setting terminal type'); return; end; call s$write(terminal_comment); if ^no_cmd then call s$stop_program(set_term_type.cmd, error_code); return; end; end ; /* an error exit */ else return; end; inquire_terminal: procedure(a_request, a_term_msg, a_error_code); declare (a_request, a_term_msg) character(*) varying, a_error_code fixed binary(15); %include 'terminal_info'; declare 1 terminal_modes based, 3 mbz bit(9), 3 translated_input bit(1), /* translated raw mode */ 3 function_key_input bit(1), /* generic key input */ 3 break_table_record bit(1), /* brk chrs delimit rcds */ 3 interrupt_key_enabled bit(1), /* interrupt key */ 3 forms_input bit(1), /* forms type ahead */ 3 complete_write bit(1), /* no partial output */ 3 input_flow bit(1), /* input flow control */ 3 bulk_raw_input bit(1), /* 1 => bulk raw input */ 3 smooth_scroll bit(1), /* 1 => smooth scrolling */ 3 generic_input bit(1), /* 1 => generic form of raw inp */ 3 black_on_white bit(1), /* 0 => black background */ 3 key_click_on bit(1), /* 0 => key click off */ 3 printing bit(1), /* printing terminal */ 3 display_enable bit(1), /* display enabled */ 3 break_enabled bit(1), /* breaks not ignored */ 3 edited_output bit(1), /* no escapes on output */ 3 raw_input bit(1), /* raw input */ 3 break_char bit(1), /* BREAK ends input */ 3 dsl_flow bit(1), /* Data Set Lead flow control */ 3 block_transfer bit(1), /* block transfer mode */ 3 use_break_table bit(1), /* 8 bit transparent */ 3 output_flow bit(1), /* DC1 DC3 processing enabled */ 3 delay_echo bit(1); /* Delay echoed lines til read */ declare (1 tinfo, 1 tinfo_save) like terminal_info, 1 tmodes defined tinfo.modes like terminal_modes, local_code fixed binary(15); declare read_buffer character(64), read_length fixed binary(15); tinfo.version = TERMINAL_INFO_VERSION_2; call s$control(TERMINAL_PORT_ID, GET_INFO_OPCODE, tinfo.version, a_error_code); if a_error_code ^= 0 then do; call s$error(a_error_code, MY_NAME, 'inquiry terminal - getting terminal info'); return; end; tinfo_save = tinfo; tmodes.forms_input = FALSE; tmodes.generic_input = FALSE; tmodes.bulk_raw_input = TRUE; tmodes.raw_input = TRUE; call s$control(TERMINAL_PORT_ID, SET_INFO_OPCODE, tinfo.version, a_error_code); if a_error_code ^= 0 then do; call s$error(a_error_code, MY_NAME, 'inquiry terminal - setting terminal info'); goto exit_inquire_terminal; end; call s$set_io_time_limit(TERMINAL_PORT_ID, 1024 * wait_timer, a_error_code); if a_error_code ^= 0 then do; call s$error(a_error_code, MY_NAME, 'inquiry terminal - setting io time limit'); goto exit_inquire_terminal; end; call s$write_raw(TERMINAL_PORT_ID, length(a_request), (a_request), a_error_code); if a_error_code ^= 0 then do; call s$error(a_error_code, MY_NAME, 'inquiry terminal - writing terminal inquiry'); goto exit_inquire_terminal; end; a_term_msg = '' ; do while (a_error_code ^= e$timeout); call s$read_raw(TERMINAL_PORT_ID, length(read_buffer), read_length, read_buffer, a_error_code); if a_error_code = e$long_record | a_error_code = e$short_record then a_error_code = 0; if a_error_code ^= 0 & a_error_code ^= e$timeout then do; call s$error(a_error_code, MY_NAME, 'inquiry terminal - reading terminal response'); goto exit_inquire_terminal; end; a_term_msg = a_term_msg || substr(read_buffer, 1, read_length); end; if a_error_code = e$timeout & length(a_term_msg) > 0 then a_error_code = 0; exit_inquire_terminal: ; call s$control(TERMINAL_PORT_ID, SET_INFO_OPCODE, tinfo_save.version, local_code); if local_code ^= 0 then do; call s$error(local_code, MY_NAME, 'inquiry terminal - resetting terminal info'); end; call s$set_io_time_limit(TERMINAL_PORT_ID, -1, local_code); if local_code ^= 0 then do; call s$error(local_code, MY_NAME, 'inquiry terminal - resetting io time limit'); end; end inquire_terminal; open_type_table: procedure(a_table_path, a_table_port, a_error_code); declare a_table_path character(256) varying, a_table_port fixed binary(15), a_error_code fixed binary(15); call s$attach_port('', a_table_path, 0, /* go away after the program is over */ a_table_port, a_error_code); if a_error_code ^= 0 then do; call s$error(a_error_code, MY_NAME, 'attaching port to term table'); return; end; call s$open(a_table_port, RELATIVE_FILE, 0, /* file exists */ INPUT_TYPE, IMPLICIT_LOCKING, INDEXED_MODE, 'inq', a_error_code); if a_error_code ^= 0 then do; call s$error(a_error_code, MY_NAME, 'opening term table'); return; end; end open_type_table; end set_terminal_type;