home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / vos / set_terminal_type.pl1 < prev    next >
Text File  |  2000-03-21  |  16KB  |  385 lines
  1. /*****************************************************************************/
  2. /* set_terminal_type - a program to determine a terminals type               */
  3. /*                                                                           */
  4. /*             Original Version: 89-05-04                                    */
  5. /*             Modification History                                          */
  6. /*             End of modification history                                   */
  7. /*****************************************************************************/
  8.  
  9. %options system_programming, no_mapcase;
  10. %nolist;                                     /* indent format options */
  11. /*: continuation_offset=8, then_else_indentation=0, right_margin=78, 
  12.    remark_column=46, indentation_offset=5, replace_value_column=36,
  13.    dcl_attributes_column=36, align_replace_values, align_dcl_attributes,
  14.    align_dcl_continuation,align_comment_body, fill, embed_remarks,
  15.    ^space_before_parens */
  16. %list;
  17.  
  18. /* ========================================================================= */
  19.  
  20. %replace MY_NAME                   by 'set_terminal_type';
  21. %replace TRUE                      by '1'b;
  22. %replace FALSE                     by '0'b;
  23.  
  24. %include 'system_io_constants';
  25. %include 'term_control_opcodes';
  26.  
  27. declare  s$error                   entry(fixed bin(15), char(*) var, char(*)
  28.                                    var);
  29.  
  30. declare  s$control                 entry(fixed bin(15), fixed bin(15), fixed
  31.                                    bin(15), fixed bin(15));
  32.  
  33. declare  s$set_io_time_limit       entry(fixed bin(15), fixed bin(31), fixed
  34.                                    bin(15));
  35.  
  36. declare  s$write_raw               entry(fixed bin(15), fixed bin(15),
  37.                                    char(*), fixed bin(15));
  38.  
  39. declare  s$read_raw                entry(fixed bin(15), fixed bin(15), fixed
  40.                                    bin(15), char(*), fixed bin(15));
  41.  
  42. declare  s$sleep                   entry(fixed bin(31), fixed bin(15));
  43.  
  44. declare  s$write                   entry(char(*) var);
  45.  
  46. declare  s$seq_read                entry(fixed bin(15), fixed bin(15), fixed
  47.                                    bin(15), char(*), fixed bin(15));
  48.  
  49. declare  s$attach_port             entry(char(32) var, char(256) var, fixed
  50.                                    bin(15), fixed bin(15), fixed bin(15));
  51.  
  52. declare  s$open                    entry(fixed bin(15), fixed bin(15), fixed
  53.                                    bin(15), fixed bin(15), fixed bin(15),
  54.                                    fixed bin(15), char(32) var, fixed
  55.                                    bin(15));
  56.  
  57. declare  s$stop_program            entry (char (*) var, fixed bin (15));
  58.  
  59. declare (e$end_of_file,
  60.          e$long_record,
  61.          e$short_record,
  62.          e$timeout)                fixed binary(15) external;
  63.  
  64. declare  1  stt                    based,
  65.             2  inq                 char(32), /* query character string     */
  66.             2  pref                char(32) varying,
  67.                                              /* identifiying prefix        */
  68.             2  default             char(32) varying,
  69.                                              /* default term type          */
  70.             2  type_off            bin(15),  /* type location              */
  71.             2  type_len            bin(15),  /* type length                */
  72.             2  parms(5),
  73.                3  name             char(32) varying,
  74.                                              /* parameter to display       */
  75.                3  offset           bin(15),  /* parm location              */
  76.                3  len              bin(15),  /* parm length                */
  77.             2  cmd                 char(300) varying;
  78.                                              /* cmd to execute for this trm*/
  79.  
  80. declare  s$parse_command           entry(char(*) var, bin(15),
  81.  
  82.                                    char(*) var, char(*) var,
  83.  
  84.                                    char(*) var, bin(15),
  85.  
  86.                                    char(*) var, bit(1) aligned,
  87.  
  88.                                    char(*) var, bit(1) aligned,
  89.  
  90.                                    char(*) var);
  91.  
  92. set_terminal_type:
  93.      procedure;
  94.  
  95. declare (inquiry_request,
  96.          table_path,
  97.          terminal_type,
  98.          terminal_comment,
  99.          terminal_message)         character(256) varying,
  100.          wait_timer                fixed binary(15),
  101.          ix                        fixed binary(15),
  102.          table_port                fixed binary(15),
  103.          bin15_based               fixed binary(15) based,
  104.          no_cmd                    bit(1) aligned,
  105.          raw                       bit(1) aligned,
  106.          error_code                fixed binary(15);
  107.  
  108. declare  1  set_term_type          like stt,
  109.          stt_buf                   defined set_term_type
  110.                                    character(bytesize(stt));
  111.  
  112.      call s$parse_command(MY_NAME, error_code,
  113.  
  114.              'stt:pathname.table,req,=stt.table', table_path,
  115.  
  116.              'option(wait_timer),number,word,=3', wait_timer,
  117.  
  118.              'switch(raw),secret,=0', raw,
  119.  
  120.              'switch(no_cmd),secret,=0', no_cmd,
  121.  
  122.              'end');
  123.      if error_code ^= 0
  124.      then return;
  125.  
  126.      call open_type_table(table_path, table_port, error_code);
  127.      if error_code ^= 0
  128.      then return;
  129.  
  130.      call s$seq_read(table_port, bytesize(stt), 0, stt_buf, error_code);
  131.      if error_code ^= 0
  132.      then do;
  133.           call s$error(error_code, MY_NAME,
  134.                   'reading term type table - initial read');
  135.           return;
  136.           end;
  137.  
  138.      do while (error_code = 0);
  139. /*  perform an inquiry                                                  */
  140.           inquiry_request = ltrim(rtrim(set_term_type.inq));
  141.           call inquire_terminal(inquiry_request, terminal_message,
  142.                   error_code);
  143.           if error_code = e$timeout
  144.           then do;
  145. /*  the terminal did not respond to this inquiry                        */
  146.                do while (inquiry_request = ltrim(rtrim(set_term_type.inq)));
  147.                     call s$seq_read(table_port, bytesize(stt), 0, stt_buf,
  148.                             error_code);
  149.                     if error_code ^= 0 & error_code ^= e$end_of_file
  150.                     then do;
  151.                          call s$error(error_code, MY_NAME,
  152.                                  'reading term type table - read next');
  153.                          return;
  154.                          end;
  155. /* cannot identify the terminal                                         */
  156.                     if error_code = e$end_of_file
  157.                     then return;
  158.                end;
  159.                end;
  160.           else if error_code = 0
  161. /*  got a response - see if it matches                                  */
  162.           then do;
  163.  
  164.                if raw
  165.                then call s$write('response->' || terminal_message);
  166.  
  167.                do while ((length(terminal_message) <
  168.                              length(set_term_type.pref) |
  169.                           set_term_type.pref ^= substr(terminal_message, 1,
  170.                               min(length(set_term_type.pref),
  171.                                   length(terminal_message)))) &
  172.                          inquiry_request = ltrim(rtrim(set_term_type.inq)));
  173.                     call s$seq_read(table_port, bytesize(stt), 0, stt_buf,
  174.                             error_code);
  175.                     if error_code ^= 0 & error_code ^= e$end_of_file
  176.                     then do;
  177.                          call s$error(error_code, MY_NAME,
  178.                                  'reading term type table - read next');
  179.                          return;
  180.                          end;
  181. /* cannot identify the terminal                                         */
  182.                     if error_code = e$end_of_file
  183.                     then do;
  184.                          call s$write('unknown: ' || terminal_type);
  185.                          return;
  186.                          end;
  187.                end;
  188.  
  189.                if inquiry_request = ltrim(rtrim(set_term_type.inq))
  190.                then do ;
  191. /* got a match                                                          */
  192.                     if set_term_type.type_off ^= -1
  193.                     then terminal_type = substr(terminal_message,
  194.                             set_term_type.type_off, set_term_type.type_len);
  195.                     else terminal_type = set_term_type.default;
  196.                     terminal_comment = 'terminal type: ' ||
  197.                             terminal_type || ' ';
  198.                     do ix = 1 to 5;
  199.                          if set_term_type.parms(ix).offset ^= -1 &
  200.                                  length(terminal_message) >=
  201.                                  set_term_type.parms(ix).offset
  202.                          then do;
  203.                               terminal_comment = terminal_comment ||
  204.                                       set_term_type.parms(ix).name ||
  205.                                       substr(terminal_message,
  206.                                       set_term_type.parms(ix).offset,
  207.                                       min(set_term_type.parms(ix).len,
  208.                                       length(terminal_message) -
  209.                                       set_term_type.parms(ix).offset));
  210.                               end;
  211.      
  212.                     end;
  213.                     call s$control(TERMINAL_PORT_ID, SET_TERMINAL_TYPE_OPCODE,
  214.                             addr(terminal_type) -> bin15_based, error_code);
  215.                     if error_code ^= 0
  216.                     then do;
  217.                          call s$error(error_code, MY_NAME,
  218.                                  'setting terminal type');
  219.                          return;
  220.                          end;
  221.                     call s$write(terminal_comment);
  222.                     if ^no_cmd
  223.                     then call s$stop_program(set_term_type.cmd, error_code);
  224.                     return;
  225.                     end;
  226.                end ;
  227. /*  an error exit                                                       */
  228.           else return;
  229.      end;
  230.  
  231. inquire_terminal:
  232.      procedure(a_request, a_term_msg, a_error_code);
  233.  
  234. declare (a_request,
  235.          a_term_msg)               character(*) varying,
  236.          a_error_code              fixed binary(15);
  237.  
  238. %include 'terminal_info';
  239.  
  240. declare  1  terminal_modes         based,
  241.                3  mbz              bit(9),
  242.                3  translated_input bit(1),   /* translated raw mode */
  243.                3  function_key_input
  244.                                    bit(1),   /* generic key input */
  245.                3  break_table_record
  246.                                    bit(1),   /* brk chrs delimit rcds */
  247.                3  interrupt_key_enabled
  248.                                    bit(1),   /* interrupt key */
  249.                3  forms_input      bit(1),   /* forms type ahead */
  250.                3  complete_write   bit(1),   /* no partial output */
  251.                3  input_flow       bit(1),   /* input flow control */
  252.                3  bulk_raw_input   bit(1),   /* 1 => bulk raw input */
  253.                3  smooth_scroll    bit(1),   /* 1 => smooth scrolling */
  254.                3  generic_input    bit(1),   /* 1 => generic form of raw inp */
  255.                3  black_on_white   bit(1),   /* 0 => black background */
  256.                3  key_click_on     bit(1),   /* 0 => key click off */
  257.                3  printing         bit(1),   /* printing terminal */
  258.                3  display_enable   bit(1),   /* display enabled */
  259.                3  break_enabled    bit(1),   /* breaks not ignored */
  260.                3  edited_output    bit(1),   /* no escapes on output */
  261.                3  raw_input        bit(1),   /* raw input */
  262.                3  break_char       bit(1),   /* BREAK ends input */
  263.                3  dsl_flow         bit(1),   /* Data Set Lead flow control */
  264.                3  block_transfer   bit(1),   /* block transfer mode */
  265.                3  use_break_table  bit(1),   /* 8 bit transparent */
  266.                3  output_flow      bit(1),   /* DC1 DC3 processing enabled */
  267.                3  delay_echo       bit(1);   /* Delay echoed lines til read */
  268.  
  269. declare (1  tinfo,
  270.          1  tinfo_save)            like terminal_info,
  271.          1  tmodes                 defined tinfo.modes like terminal_modes,
  272.          local_code                fixed binary(15);
  273.  
  274. declare  read_buffer               character(64),
  275.          read_length               fixed binary(15);
  276.  
  277.      tinfo.version = TERMINAL_INFO_VERSION_2;
  278.      call s$control(TERMINAL_PORT_ID, GET_INFO_OPCODE, tinfo.version,
  279.              a_error_code);
  280.      if a_error_code ^= 0
  281.      then do;
  282.           call s$error(a_error_code, MY_NAME,
  283.                   'inquiry terminal - getting terminal info');
  284.           return;
  285.           end;
  286.  
  287.      tinfo_save = tinfo;
  288.  
  289.      tmodes.forms_input = FALSE;
  290.      tmodes.generic_input = FALSE;
  291.      tmodes.bulk_raw_input = TRUE;
  292.      tmodes.raw_input = TRUE;
  293.  
  294.      call s$control(TERMINAL_PORT_ID, SET_INFO_OPCODE, tinfo.version,
  295.              a_error_code);
  296.      if a_error_code ^= 0
  297.      then do;
  298.           call s$error(a_error_code, MY_NAME,
  299.                   'inquiry terminal - setting terminal info');
  300.           goto exit_inquire_terminal;
  301.           end;
  302.  
  303.      call s$set_io_time_limit(TERMINAL_PORT_ID, 1024 * wait_timer,
  304.              a_error_code);
  305.      if a_error_code ^= 0
  306.      then do;
  307.           call s$error(a_error_code, MY_NAME,
  308.                   'inquiry terminal - setting io time limit');
  309.           goto exit_inquire_terminal;
  310.           end;
  311.  
  312.      call s$write_raw(TERMINAL_PORT_ID, length(a_request), (a_request),
  313.              a_error_code);
  314.      if a_error_code ^= 0
  315.      then do;
  316.           call s$error(a_error_code, MY_NAME,
  317.                   'inquiry terminal - writing terminal inquiry');
  318.           goto exit_inquire_terminal;
  319.           end;
  320.  
  321.      a_term_msg = '' ;
  322.      do while (a_error_code ^= e$timeout);
  323.           call s$read_raw(TERMINAL_PORT_ID, length(read_buffer), read_length,
  324.                   read_buffer, a_error_code);
  325.           if a_error_code = e$long_record | a_error_code = e$short_record
  326.           then a_error_code = 0;
  327.           if a_error_code ^= 0 & a_error_code ^= e$timeout
  328.           then do;
  329.                call s$error(a_error_code, MY_NAME,
  330.                        'inquiry terminal - reading terminal response');
  331.                goto exit_inquire_terminal;
  332.                end;
  333.           a_term_msg = a_term_msg || substr(read_buffer, 1, read_length);
  334.      end;
  335.  
  336.      if a_error_code = e$timeout & length(a_term_msg) > 0
  337.      then a_error_code = 0;
  338.  
  339. exit_inquire_terminal:
  340.      ;
  341.  
  342.      call s$control(TERMINAL_PORT_ID, SET_INFO_OPCODE, tinfo_save.version,
  343.              local_code);
  344.      if local_code ^= 0
  345.      then do;
  346.           call s$error(local_code, MY_NAME,
  347.                   'inquiry terminal - resetting terminal info');
  348.           end;
  349.  
  350.      call s$set_io_time_limit(TERMINAL_PORT_ID, -1, local_code);
  351.      if local_code ^= 0
  352.      then do;
  353.           call s$error(local_code, MY_NAME,
  354.                   'inquiry terminal - resetting io time limit');
  355.           end;
  356.  
  357.      end inquire_terminal;
  358.  
  359. open_type_table:
  360.      procedure(a_table_path, a_table_port, a_error_code);
  361. declare  a_table_path              character(256) varying,
  362.          a_table_port              fixed binary(15),
  363.          a_error_code              fixed binary(15);
  364.  
  365.      call s$attach_port('', a_table_path, 0,
  366.              /*  go away after the program is over */ a_table_port,
  367.              a_error_code);
  368.      if a_error_code ^= 0
  369.      then do;
  370.           call s$error(a_error_code, MY_NAME, 'attaching port to term table');
  371.           return;
  372.           end;
  373.  
  374.      call s$open(a_table_port, RELATIVE_FILE, 0, /* file exists      */
  375.              INPUT_TYPE, IMPLICIT_LOCKING, INDEXED_MODE, 'inq', a_error_code);
  376.      if a_error_code ^= 0
  377.      then do;
  378.           call s$error(a_error_code, MY_NAME, 'opening term table');
  379.           return;
  380.           end;
  381.  
  382.      end open_type_table;
  383.  
  384.      end set_terminal_type;
  385.