1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) Honeywell Bull Inc., 1987                *
   4         *                                                         *
   5         * Copyright, (C) Honeywell Information Systems Inc., 1981 *
   6         *                                                         *
   7         *********************************************************** */
   8 
   9 
  10 
  11 /****^  HISTORY COMMENTS:
  12   1) change(87-06-16,LJAdams), approve(87-06-16,MCR7584),
  13      audit(87-07-23,Gilcrease), install(87-08-04,MR12.1-1055):
  14      Changed editing_chars_version_2 to editing_chars_version_3 which
  15      includes the redisplay character (for DSA only).
  16      editing_chars_version_2 will still be accepted.
  17   2) change(87-07-10,LJAdams), approve(87-07-10,MCR7742),
  18      audit(87-07-23,Gilcrease), install(87-08-04,MR12.1-1055):
  19      Changed to accept either scroll or line_count as a valid value for
  20      mv.char_value.
  21   3) change(88-02-08,Brunelle), approve(88-02-08,MCR7813),
  22      audit(88-10-12,Blair), install(88-10-17,MR12.2-1171):
  23      Change to use SPECIAL_VERSION_2 instead of SPECIAL_VERSION of special
  24      chars structure.  Change set/get_special control orders to automatically
  25      handle old(3)/new(15) lengths of special_chars.
  26   4) change(88-10-20,Brunelle), approve(88-10-20,PBF7813),
  27      audit(88-10-20,Farley), install(88-10-20,MR12.2-1175):
  28      Correct "ptr being referenced but never set" problem.  Also altered method
  29      used to copy old-version special chars structures from/to new version to
  30      use a more efficient manner.
  31   5) change(89-02-27,Lee), approve(89-03-14,MCR8075), audit(89-04-20,Flegel),
  32      install(89-05-10,MR12.3-1041):
  33      phx19510 (Video 91) - fixed to handle problem with setting of editing
  34      chars when the erase and kill characters are being interchanged.
  35                                                    END HISTORY COMMENTS */
  36 
  37 
  38 /* wioctl_ -- control orders and modes for window_io_ */
  39 /* Benson I. Margulies, sometime in 1981 */
  40 /* Modified 11 December 1981 by Chris Jones to add more_mode=fold */
  41 /* Modified 15 December 1981 by Chris Jones to add set_editing_chars */
  42 /* Modified 11 January 1982 by Chris Jones to clear break table entries
  43    on ^erkl and ^esc modes */
  44 /* Modified 26 January 1982 by William York to implement user-settable
  45    more handlers. */
  46 /* Modified 3 February 1982 by Chris Jones to fix set_window_info so cursor
  47    always lands in the window */
  48 /* Modified 28 April 1982 by WMY to return the current more handler routine
  49    (if any) in a set_more_handler call. version 2 of more_handler_info. */
  50 /* Modified 26 August 1982 by WMY to add the send_buffered_output order, and
  51    pass any unrecognized order on to tc_ level. */
  52 /* Modified 20 September 1982 by WMY to remove the send_buffered_output
  53    control order, since window_$sync is a better mechanism. */
  54 /* Modified 18 October 1982 by WMY to re-allocate the window image when the
  55    size of a window is changed via set_window_info. */
  56 /* Modified October 1982 by WMY to add set_ and get_token_characters and
  57    set_ and get_more_prompt. */
  58 /* Modified January 1983 by WMY to add io_call support. */
  59 /* Modified February 1983 by WMY to add set_editor_key_bindings. */
  60 /* Modified 8 May 1983 by WMY to add io_call support for set and
  61    get_window_status and set and get_token_characters. */
  62 /* Modified 7 June 1983 by WMY to make set_window_info check the elements
  63    of the window_position_info structure for reasonable values and
  64    actually set the width of the window instead of ignoring the width
  65    specified by the caller. */
  66 /* Modified 14 June 1983 by WMY to use version 2 line_editor_key_binding_info
  67    structure, and interpret a 0 width specification in a set_window_info
  68    order as a full-screen-width window. */
  69 /* Modified 15 June 1983 by WMY to change set_editing_chars to use the
  70    set_editor_key_bindings order, and unbind the old editing chars. */
  71 /* Modified 2 August 1983 by Jon A. Rochlis to make get_window_status zero
  72    attach_data.status, not just attach_data.status_pending, and to
  73    add io_call support for set_window_status */
  74 /* Modified 6 August 1983 by JR to add io_call support for get_more_responses,
  75    get_more_prompt, and (set get)_editing_chars.  Also to improve error
  76    reporting in io_call processing, and to elimitate duplicate error messages
  77    by zeroing code before returning if we report the error.  Also to remove
  78    the special casing of the terminal_info control, since we pass anything
  79    unrecognized to tc_ anyway. */
  80 /* Modified 7 August 1983 by JR to add get_more_handler and io_call support
  81    for it. */
  82 /* Modified 7-8 August 1983 by JR for better io_call support for
  83    set_editor_key_bindings, added -builtin and -numarg control args */
  84 /* Modified 2 September 1983 by JR for case insensitive comparisons of
  85    builtin requests and numarg actions for set_editor_key_bindings */
  86 /* Modified 8 October 1983 by JR for partial screen width support.  Made
  87    set_window_info set the new fields in tc_desk_info, and default column
  88    origin to 1 if we get passed 0 (it used to be a mbz). */
  89 /* Modified December 1983 by JR to make get_capabilites set the various
  90    flags correctly for partial width windows, and to make get_window_info
  91    set window_position.origin.column */
  92 /* Modified 23 December 1983 by JR to support the (set get)_output_conversion
  93    and (set get)_special control orders.  Merry Christmas!! */
  94 /* Modified 8 January 1983 by JR to explicitly do a get_capabilities to
  95    determine if more_mode=SCROLL rather than relying on
  96    attach_data.capabilities which is going away. */
  97 /* Modified 1 February 1984 by JR to support the removal of window_io_video_
  98    by adding the get_window_iocb_ptr for window_, and adding support for
  99    read_status here, since all roads lead to wioctl_ for control orders. */
 100 /* Modified 29 February 1984 by Barmar to add get_editor_key_bindings
 101    control order, and make set_key_binding free dispatch tables that become
 102    garbage */
 103 /* Modified 1 March 1984 by Barmar to change "goto error_return" into
 104    "call error_exit", and to upgrade set_editor_key_bindings to support
 105    the new set_editor_key_bindings info structure. */
 106 /* Modified 9 March 1984 by Barmar - Fixed lots of invalid code, add
 107    io_call support for setting name, description, and info_path,
 108    implemented io_call get_editor_key_bindings */
 109 /* Modified 22 March 1984 by Barmar - Added (set get)_audit_iocb_ptr control
 110    orders. */
 111 /* Modified 28 March 1984 by JR to add support for window_iocb_ptr in
 112    tc_desk_info, and to add support to get_window_status for
 113    W_STATUS_TTP_CHANGE and W_STATUS_RECONNECTION. */
 114 /* Modified 01 September 1984 by JR to add edited mode. */
 115 
 116 /* format: style4,delnl,insnl,indattr,ifthen,dclind9 */
 117 wioctl_:
 118      procedure;
 119 
 120 declare  (
 121          (Old_modes, New_modes, Order)
 122                                 character (*),
 123          Code                   fixed bin (35),
 124          Iocb_ptr               pointer,
 125          Info_ptr               pointer
 126          )                      parameter;
 127 
 128 declare  temp_ptr               pointer;
 129 ^L
 130 
 131 declare  mode_string_$parse     entry (character (*), pointer, pointer, fixed binary (35));
 132 
 133 declare  ioa_$rsnnl             entry () options (variable);
 134 declare  pathname_              entry (char (*), char (*)) returns (char (168));
 135 declare  requote_string_        entry (char (*)) returns (char (*));
 136 declare  window_io_iox_$reset_more_entry
 137                                 entry (pointer);
 138 
 139 declare  target_iocbp           pointer;
 140 declare  modex                  fixed bin;
 141 declare  force_mode             bit (1) aligned;
 142 declare  binding_index          fixed bin;
 143 
 144 declare  1 auto_capabilities_info
 145                                 aligned like capabilities_info;
 146 
 147 declare  1 desk_info            aligned like tc_desk_window_info;
 148 
 149 declare  (
 150          video_et_$bad_window_id,
 151          video_et_$overlapping_more_responses,
 152          video_et_$window_too_big,
 153          video_et_$no_more_handler_in_use,
 154          error_table_$bad_subr_arg,
 155          error_table_$bad_mode_value,
 156          error_table_$inconsistent,
 157          error_table_$null_info_ptr,
 158          error_table_$invalid_array_size
 159          )                      external static fixed bin (35);
 160 declare  error_table_$bad_mode  fixed bin (35) ext static;
 161 declare  error_table_$unimplemented_version
 162                                 fixed bin (35) ext static;
 163 
 164 declare  (addr, bin, byte, clock, codeptr, copy, hbound, index, lbound, length, max, null, rank, rtrim, search, string,
 165          substr, translate, unspec)
 166                                 builtin;
 167 dcl      cleanup                condition;
 168 dcl      SPACE                  char (1) static options (constant) init (" ");
 169 dcl      DEL                    char (1) static options (constant) init ("^?");
 170 dcl      WHITE_SPACE            char (5) int static options (constant) initial
 171                                                             /* CR, NL, HT, VT, FF */
 172                                 ("^M
 173           ^K^L");
 174 
 175 /* special chars structures to support old/new versions */
 176 dcl      1 special_chars_old    aligned based,              /* table of special character sequences */
 177            2 nl_seq             aligned like c_chars_old,   /* new-line sequence */
 178            2 cr_seq             aligned like c_chars_old,   /* carriage-return sequence */
 179            2 bs_seq             aligned like c_chars_old,   /* backspace sequence */
 180            2 tab_seq            aligned like c_chars_old,   /* horizontal tab sequence */
 181            2 vt_seq             aligned like c_chars_old,   /* vertical tab sequence */
 182            2 ff_seq             aligned like c_chars_old,   /* form-feed sequence */
 183            2 printer_on         aligned like c_chars_old,   /* printer-on sequence */
 184            2 printer_off        aligned like c_chars_old,   /* printer_off sequence */
 185            2 red_ribbon_shift   aligned like c_chars_old,   /* red ribbon shift sequence */
 186            2 black_ribbon_shift aligned like c_chars_old,   /* black ribbon shift sequence */
 187            2 end_of_page        aligned like c_chars_old,   /* end-of-page warning sequence */
 188            2 escape_length      fixed bin,                  /* number of escape sequences */
 189            2 not_edited_escapes (sc_escape_len refer (special_chars_old.escape_length)) like c_chars_old,
 190                                                             /* use in ^edited mode */
 191            2 edited_escapes     (sc_escape_len refer (special_chars_old.escape_length)) like c_chars_old,
 192                                                             /* use in edited mode */
 193            2 input_escapes      aligned,
 194              3 len              fixed bin (8) unaligned,    /* length of string */
 195              3 str              char (sc_input_escape_len refer (special_chars_old.input_escapes.len)) unaligned,
 196                                                             /* escape sequence characters */
 197            2 input_results      aligned,
 198              3 pad              bit (9) unaligned,          /* so that strings will look the same */
 199              3 str              char (sc_input_escape_len refer (special_chars_old.input_escapes.len)) unaligned;
 200                                                             /* results of escape sequences */
 201 
 202 
 203 dcl      1 c_chars_old          based (c_chars_ptr) aligned,
 204            2 count              fixed bin (8) unaligned,
 205            2 chars              (3) char (1) unaligned;
 206 
 207 dcl      1 special_chars_struc_old
 208                                 aligned based,
 209            2 version            fixed bin,
 210            2 default            fixed bin,                  /* non-zero indicates use default */
 211            2 special_chars,                                 /* same as level-1 above */
 212                                                             /* has to be spelled out instead of using like */
 213                                                             /* because of refer options */
 214              3 nl_seq           aligned like c_chars_old,   /* new-line sequence */
 215              3 cr_seq           aligned like c_chars_old,   /* carriage-return sequence */
 216              3 bs_seq           aligned like c_chars_old,   /* backspace sequence */
 217              3 tab_seq          aligned like c_chars_old,   /* horizontal tab sequence */
 218              3 vt_seq           aligned like c_chars_old,   /* vertical tab sequence */
 219              3 ff_seq           aligned like c_chars_old,   /* form-feed sequence */
 220              3 printer_on       aligned like c_chars_old,   /* printer-on sequence */
 221              3 printer_off      aligned like c_chars_old,   /* printer_off sequence */
 222              3 red_ribbon_shift aligned like c_chars_old,   /* red ribbon shift sequence */
 223              3 black_ribbon_shift
 224                                 aligned like c_chars_old,   /* black ribbon shift sequence */
 225              3 end_of_page      aligned like c_chars_old,   /* end-of-page warning sequence */
 226              3 escape_length    fixed bin,                  /* number of escape sequences */
 227              3 not_edited_escapes
 228                                 (sc_escape_len refer (special_chars_struc_old.escape_length)) like c_chars_old,
 229                                                             /* use in ^edited mode */
 230              3 edited_escapes   (sc_escape_len refer (special_chars_struc_old.escape_length)) like c_chars_old,
 231                                                             /* use in edited mode */
 232              3 input_escapes    aligned,
 233                4 len            fixed bin (8) unaligned,    /* length of string */
 234                4 str            char (sc_input_escape_len refer (special_chars_struc_old.input_escapes.len)) unaligned,
 235                                                             /* escape sequence characters */
 236              3 input_results    aligned,
 237                4 pad            bit (9) unaligned,          /* so that strings will look the same */
 238                4 str            char (sc_input_escape_len refer (special_chars_struc_old.input_escapes.len)) unaligned;
 239                                                             /* results of escape sequences */
 240 %page;
 241 
 242 modes:
 243      entry (Iocb_ptr, New_modes, Old_modes, Code);
 244 
 245           call setup;
 246 
 247           Old_modes = "";
 248           call ioa_$rsnnl (
 249                "more_mode=^[scroll^;clear^;wrap^;fold^],^[^^^]more,ll=^d,pl=^d,^[^^^]vertsp,^[^^^]can,^[^^^]erkl,^[^^^]esc,^[^^^]rawo,^[^^^]red,^[^^^]ctl_char,^[^^^]edited",
 250                Old_modes, (0), attach_data.more_mode, ^attach_data.more_processing, attach_data.current.columns,
 251                attach_data.current.rows, ^attach_data.flags.vertsp, ^attach_data.flags.can, ^attach_data.flags.erkl,
 252                ^attach_data.flags.esc, ^attach_data.flags.rawo, ^attach_data.flags.red, ^attach_data.flags.ctl_char,
 253                ^attach_data.flags.edited);
 254 
 255           if New_modes = "" then
 256                return;
 257           call mode_string_$parse (New_modes, get_system_free_area_ (), mode_string_info_ptr, Code);
 258           if Code ^= 0 then
 259                return;
 260 
 261           force_mode = "0"b;
 262           do modex = 1 to hbound (mode_string_info.modes, 1);
 263                call set_mode (mode_string_info.modes (modex));
 264           end;
 265 
 266 mode_error_return:
 267           free mode_string_info;
 268 
 269           return;
 270 ^L
 271 /* This procedure analyzes a single mode */
 272 set_mode:
 273      procedure (mv);
 274 dcl      1 mv                   aligned like mode_value;
 275 
 276           if mv.mode_name = "force" then
 277                force_mode = mode_value_boolean ();
 278 
 279           else if mv.mode_name = "more_mode" then do;
 280                if ^mv.char_valuep then
 281                     goto BAD_TYPE;
 282 
 283                if mv.char_value = "scroll" | mv.char_value = "line_count" then do;
 284                     auto_capabilities_info.version = capabilities_info_version_1;
 285                     call iox_$control (Iocb_ptr, "get_capabilities", addr (auto_capabilities_info), Code);
 286                     if Code ^= 0 then
 287                          return;
 288                     if ^auto_capabilities_info.scroll_region then
 289                          go to BAD_VALUE;
 290                     attach_data.more_mode = MORE_MODE_SCROLL;
 291                end;
 292                else if mv.char_value = "wrap" then
 293                     attach_data.more_mode = MORE_MODE_WRAP;
 294                else if mv.char_value = "clear" then
 295                     attach_data.more_mode = MORE_MODE_CLEAR;
 296                else if mv.char_value = "fold" then
 297                     attach_data.more_mode = MORE_MODE_FOLD;
 298                else goto BAD_TYPE;
 299           end;                                              /* more_mode */
 300           else if mv.mode_name = "more" then
 301                attach_data.more_processing = mode_value_boolean ();
 302           else if mv.mode_name = "debug" then
 303                attach_data.debug = mode_value_boolean ();
 304 
 305           else if mv.mode_name = "ll" then
 306                if mv.numeric_value ^= attach_data.current.columns then
 307                     go to BAD_VALUE;
 308                else ;                                       /* read only, but accept truth */
 309 
 310           else if mv.mode_name = "pl" then
 311                if mv.numeric_value ^= attach_data.current.rows then
 312                     go to BAD_VALUE;
 313                else ;
 314 
 315           else if mv.mode_name = "vertsp" then
 316                attach_data.flags.vertsp = mode_value_boolean ();
 317           else if mv.mode_name = "can" then
 318                attach_data.can = mode_value_boolean ();
 319 
 320 /* These two require break tbl changes as well */
 321           else if mv.mode_name = "erkl" then do;
 322                attach_data.erkl = mode_value_boolean ();
 323                call set_break_table (attach_data.erase_char, attach_data.erkl);
 324                call set_break_table (attach_data.kill_char, attach_data.erkl);
 325           end;                                              /* erkl mode */
 326 
 327           else if mv.mode_name = "esc" then do;
 328                attach_data.esc = mode_value_boolean ();
 329                call set_break_table (attach_data.input_escape_char, attach_data.esc);
 330           end;                                              /* esc mode */
 331 
 332           else if mv.mode_name = "rawo" then
 333                begin;
 334 declare  saved_r                bit (1);
 335                saved_r = attach_data.rawo;
 336                attach_data.rawo = mode_value_boolean ();
 337                if ^saved_r & attach_data.rawo & attach_data.cursor_valid then do;
 338                     attach_data.row_at_rawo = attach_data.line;
 339                     attach_data.col_at_rawo = attach_data.col;
 340                end;
 341                else if saved_r & ^attach_data.rawo then do;
 342                     attach_data.line = attach_data.row_at_rawo;
 343                     attach_data.col = attach_data.col_at_rawo;
 344                     attach_data.cursor_valid = "1"b;
 345                end;
 346           end;
 347 
 348           else if mv.mode_name = "red" then
 349                attach_data.red = mode_value_boolean ();
 350           else if mv.mode_name = "ctl_char" then
 351                attach_data.ctl_char = mode_value_boolean ();
 352           else if mv.mode_name = "edited" then
 353                attach_data.edited = mode_value_boolean ();
 354 
 355 /* support modes we've never heard of */
 356           else if ^force_mode then do;
 357                Code = error_table_$bad_mode;                /*             Old_modes = mv.mode_name; */
 358                                                             /* this should contain the invalid mode for good error messages */
 359                                                             /*             if mv.char_valuep then Old_modes = rtrim(Old_modes) || "=" || mv.char_value; */
 360                go to mode_error_return;
 361           end;
 362 
 363           return;
 364 
 365 /* check type and return mode value */
 366 
 367 mode_value_boolean:
 368           procedure returns (bit (1) aligned);              /* global mv */
 369                if ^mv.boolean_valuep then
 370                     goto BAD_TYPE;
 371                return (mv.boolean_value);
 372 
 373 mode_value_char:
 374           entry returns (char (32) varying);
 375                if ^mv.char_valuep then
 376                     goto BAD_TYPE;
 377                return (rtrim (mv.char_value));
 378 
 379 mode_value_numeric:
 380           entry returns (fixed bin (35));
 381                if ^mv.numeric_valuep then
 382                     goto BAD_TYPE;
 383                return (mv.numeric_value);
 384 
 385           end;
 386 BAD_TYPE:
 387 BAD_VALUE:
 388           Code = error_table_$bad_mode_value;
 389           goto mode_error_return;
 390      end set_mode;
 391 ^L
 392 control:
 393      entry (Iocb_ptr, Order, Info_ptr, Code);
 394           call setup;
 395 
 396           if Order = "reset_more" then
 397                call window_io_iox_$reset_more_entry (Iocb_ptr);
 398 
 399           else if Order = "send_buffered_output" then
 400                call window_$sync (Iocb_ptr, Code);
 401 
 402           else if Order = "printer_off" then
 403                attach_data.suppress_echo = "1"b;
 404           else if Order = "printer_on" then
 405                attach_data.suppress_echo = "0"b;
 406 
 407           else if Order = "get_terminal_iocb_ptr" then
 408                Info_ptr = target_iocbp;                     /* This is really very un-iox-like */
 409 
 410           else if Order = "get_window_iocb_ptr" then
 411                Info_ptr = Iocb_ptr -> actual_iocb_ptr;      /* If terminal control can do it, then window_ can do it also ... */
 412 
 413           else if Order = "get_capabilities" then do;
 414                call check_null ();
 415                call iox_$control (target_iocbp, Order, Info_ptr, Code);
 416                if Code ^= 0 then
 417                     return;
 418 
 419 /* Now map the terminal capabilities into the window capabilities */
 420                if Info_ptr -> capabilities_info.columns ^= attach_data.current.columns then do;
 421                                                             /* Illegal operations for non full width windows */
 422                     Info_ptr -> capabilities_info.scroll_region = "0"b;
 423                     Info_ptr -> capabilities_info.insert_chars = "1"b;
 424                                                             /* we simulate these if they aren't available */
 425                     Info_ptr -> capabilities_info.insert_mode = "1"b;
 426                                                             /* ? */
 427                     Info_ptr -> capabilities_info.delete_chars = "1"b;
 428                end;
 429 
 430                Info_ptr -> capabilities_info.columns = attach_data.current.columns;
 431                Info_ptr -> capabilities_info.rows = attach_data.current.rows;
 432                return;
 433           end;
 434 
 435           else if Order = "get_window_info" then do;
 436                call check_null ();
 437                window_position_info_ptr = Info_ptr;
 438                call require_version (window_position_info.version, window_position_info_version_1);
 439                window_position_info.height = attach_data.current.rows;
 440                window_position_info.width = attach_data.current.columns;
 441                window_position_info.origin.column = attach_data.column_origin;
 442                window_position_info.origin.line = attach_data.line_origin;
 443           end;
 444 
 445           else if Order = "set_window_info" then do;
 446                call check_null ();
 447                window_position_info_ptr = Info_ptr;
 448                call require_version (window_position_info.version, window_position_info_version_1);
 449 
 450                auto_capabilities_info.version = capabilities_info_version_1;
 451                call iox_$control (target_iocbp, "get_capabilities", addr (auto_capabilities_info), Code);
 452                if Code ^= 0 then
 453                     return;
 454 
 455 /* Verify that the new window position and bounds are within
 456    the screen bounds */
 457 /* tc_ will verify that start+length-1 is within bounds ...
 458    perhaps this should all be done in one place */
 459 
 460                Code = video_et_$window_too_big;
 461 
 462                if (window_position_info.origin.line > auto_capabilities_info.screensize.rows)
 463                     | (window_position_info.origin.line < 1) then
 464                     return;
 465 
 466                if window_position_info.extent.height < 1 then
 467                     return;
 468 
 469                if (window_position_info.origin.line + window_position_info.extent.height - 1)
 470                     > auto_capabilities_info.screensize.rows then
 471                     return;
 472 
 473                if window_position_info.origin.column = 0 then
 474                     window_position_info.origin.column = 1;
 475 
 476                if window_position_info.origin.column < 1
 477                     | window_position_info.origin.column > auto_capabilities_info.screensize.columns then
 478                     return;
 479 
 480                if window_position_info.extent.width > auto_capabilities_info.screensize.columns then
 481                     return;
 482 
 483                if window_position_info.extent.width = 0 then
 484                     window_position_info.extent.width = auto_capabilities_info.screensize.columns;
 485 
 486                Code = 0;
 487 
 488                desk_info.window_id = attach_data.window_id;
 489                desk_info.first_row = window_position_info.origin.line;
 490                desk_info.n_rows = window_position_info.extent.height;
 491                desk_info.first_column = window_position_info.origin.column;
 492                desk_info.n_columns = window_position_info.extent.width;
 493 
 494                call iox_$control (target_iocbp, "resize_window", addr (desk_info), Code);
 495 
 496                if Code = video_et_$bad_window_id then do;
 497                     call iox_$control (target_iocbp, "check_out_window", addr (desk_info), (0));
 498                     desk_info.window_iocb_ptr = Iocb_ptr -> iocb.actual_iocb_ptr;
 499                     call iox_$control (target_iocbp, "check_in_window", addr (desk_info), Code);
 500                     if Code = 0 then
 501                          attach_data.window_id = desk_info.window_id;
 502                end;
 503                if Code ^= 0 then
 504                     return;
 505 
 506 /* Free the old-size window image. */
 507                if attach_data.window_image_ptr ^= null () then
 508                     free window_image in (attach_data_area);
 509 
 510 rearrange_window:
 511                begin;
 512 declare  origin_change          fixed bin;
 513 declare  bottom_line_change     fixed bin;
 514 declare  old_origin             fixed bin;
 515 declare  old_bottom_line        fixed bin;
 516 declare  new_bottom_line        fixed bin;
 517 
 518 declare  saved_ignore_status    bit (1) aligned;
 519 
 520 declare  cleanup                condition;
 521 
 522                     saved_ignore_status = attach_data.ignore_status;
 523 
 524                     on cleanup attach_data.ignore_status = saved_ignore_status;
 525                     attach_data.ignore_status = "1"b;
 526 
 527                     string (attach_data.status) = ""b;
 528                     attach_data.status_pending = "0"b;
 529 
 530                     origin_change = attach_data.current.line_origin - window_position_info.line;
 531                                                             /* + if it went up, got new turf */
 532                     old_origin = attach_data.current.line_origin;
 533 
 534                     new_bottom_line = window_position_info.line + window_position_info.height - 1;
 535                     old_bottom_line = old_origin + attach_data.current.rows - 1;
 536 
 537                     bottom_line_change = new_bottom_line - old_bottom_line;
 538 
 539                     attach_data.current.rows = window_position_info.height;
 540                     attach_data.line_origin = window_position_info.line;
 541 
 542                     attach_data.current.columns = window_position_info.width;
 543                     attach_data.column_origin = window_position_info.column;
 544 
 545                     if ^(((attach_data.current.line_origin >= old_origin)
 546                                                             /** **/
 547                          & (attach_data.current.line_origin <= new_bottom_line))
 548                                                             /* top is within old space */
 549                          | ((new_bottom_line >= old_origin) /** **/
 550                          & (new_bottom_line <= old_bottom_line)))
 551                                                             /* no overlap */
 552                     then do;
 553                          call window_$position_cursor (Iocb_ptr, (1), (1), (0));
 554                          call window_io_iox_$reset_more_entry (Iocb_ptr);
 555                     end;
 556 
 557                     else do;                                /* There is some overlap, clear the new turf */
 558 
 559                          if attach_data.line > attach_data.current.rows then
 560                               call window_$position_cursor (Iocb_ptr, attach_data.current.rows, (1), (0));
 561                          else if origin_change > 0 then
 562                               call window_$change_line (Iocb_ptr, attach_data.line + origin_change, (0));
 563                                                             /* same place on screen */
 564 
 565                     end;
 566 
 567                     attach_data.ignore_status = saved_ignore_status;
 568                end rearrange_window;
 569 
 570                call ioa_$rsnnl ("window_io_ ^a -first_line ^i -n_lines ^i -first_column ^i -n_columns ^i",
 571                     attach_data.attach_description, (0), attach_data.target_iocb_ptr -> iocb.name,
 572                     attach_data.line_origin, attach_data.current.rows, attach_data.column_origin,
 573                     attach_data.current.columns);
 574 
 575                attach_data.status_pending = "0"b;
 576                string (attach_data.status) = ""b;
 577 
 578                if attach_data.async_count > 0 then do;
 579                     attach_data.status_pending = "1"b;
 580                     attach_data.status.screen_invalid = "1"b;
 581                end;
 582 
 583 /* Now that all re-sizing is done, allocate new window image. */
 584                allocate window_image in (attach_data_area);
 585 
 586                if ^(attach_data.more_mode = MORE_MODE_SCROLL) then
 587                     return;
 588 
 589                auto_capabilities_info.version = capabilities_info_version_1;
 590                call iox_$control (Iocb_ptr, "get_capabilities", addr (auto_capabilities_info), Code);
 591                                                             /* window capabilities */
 592                if Code ^= 0 then
 593                     return;                                 /* at least we tried */
 594                if ^auto_capabilities_info.scroll_region then
 595                     attach_data.more_mode = MORE_MODE_WRAP;
 596 
 597                return;
 598           end;
 599 
 600           else if Order = "get_editing_chars" then do;
 601                call check_null ();
 602                editing_chars_ptr = Info_ptr;
 603                call require_version (editing_chars.version, editing_chars_version_3);
 604                editing_chars.erase = attach_data.erase_char;
 605                editing_chars.kill = attach_data.kill_char;
 606           end;
 607 
 608           else if Order = "set_editing_chars" then do;
 609                call check_null ();
 610                editing_chars_ptr = Info_ptr;
 611                call require_version (editing_chars.version, editing_chars_version_3);
 612                if index (WHITE_SPACE, editing_chars.erase) ^= 0 | index (WHITE_SPACE, editing_chars.kill) ^= 0
 613                     | editing_chars.erase = editing_chars.kill then
 614                     Code = error_table_$inconsistent;
 615 
 616                else do;
 617 
 618                     begin;
 619 dcl      1 lekbi                aligned like line_editor_key_binding_info based (sekbi.key_binding_info_ptr);
 620 dcl      1 sekbi                aligned like set_editor_key_bindings_info;
 621 
 622                          sekbi.version = set_editor_key_bindings_info_version_1;
 623                          sekbi.update = "1"b;
 624                          sekbi.replace = "0"b;
 625                          sekbi.mbz = (34)"0"b;
 626                          sekbi.key_binding_info_ptr = null ();
 627                          line_editor_binding_count = 4;
 628                          line_editor_longest_sequence = 1;
 629 
 630                          on cleanup
 631                               begin;
 632                               if sekbi.key_binding_info_ptr ^= null () then
 633                                    free lekbi in (attach_data_area);
 634                          end;
 635                          allocate lekbi in (attach_data_area);
 636 
 637                          lekbi.version = line_editor_key_binding_info_version_3;
 638 
 639 /* We may end up setting either character or both */
 640                          lekbi.binding_count = 0;
 641 
 642 /* SPACE means don't change that character */
 643 
 644 /* RL: phx19510 - handle case where both erase and kill are specified and */
 645 /*       possibly being interchanged  */
 646                          if editing_chars.erase ^= SPACE & editing_chars.kill ^= SPACE then do;
 647                               lekbi.binding_count = lekbi.binding_count + 4;
 648 
 649 /* First unbind the previous erase char, to
 650    SELF_INSERT if it is a printing graphic or
 651    UNDEFINED if it is not. */
 652 
 653                               if (attach_data.erase_char >= SPACE) & (attach_data.erase_char < DEL) then
 654                                    lekbi.bindings (lekbi.binding_count - 3).action = SELF_INSERT;
 655                               else lekbi.bindings (lekbi.binding_count - 3).action = UNDEFINED;
 656                               lekbi.bindings (lekbi.binding_count - 3).sequence = attach_data.erase_char;
 657 
 658                               lekbi.bindings (lekbi.binding_count - 1).action = BACKWARD_DELETE_CHARACTER;
 659                               lekbi.bindings (lekbi.binding_count - 1).sequence = editing_chars.erase;
 660 
 661                               attach_data.erase_char = editing_chars.erase;
 662 
 663                               if (attach_data.kill_char >= SPACE) & (attach_data.kill_char < DEL) then
 664                                    lekbi.bindings (lekbi.binding_count - 2).action = SELF_INSERT;
 665                               else lekbi.bindings (lekbi.binding_count - 2).action = UNDEFINED;
 666                               lekbi.bindings (lekbi.binding_count - 2).sequence = attach_data.kill_char;
 667 
 668                               lekbi.bindings (lekbi.binding_count).action = KILL_TO_BEGINNING_OF_LINE;
 669                               lekbi.bindings (lekbi.binding_count).sequence = editing_chars.kill;
 670 
 671                               attach_data.kill_char = editing_chars.kill;
 672 
 673 
 674 
 675                          end;
 676 
 677                          else if editing_chars.erase ^= SPACE then do;
 678                               lekbi.binding_count = lekbi.binding_count + 2;
 679 
 680 /* First unbind the previous erase char, to
 681    SELF_INSERT if it is a printing graphic or
 682    UNDEFINED if it is not. */
 683 
 684                               if (attach_data.erase_char >= SPACE) & (attach_data.erase_char < DEL) then
 685                                    lekbi.bindings (lekbi.binding_count - 1).action = SELF_INSERT;
 686                               else lekbi.bindings (lekbi.binding_count - 1).action = UNDEFINED;
 687                               lekbi.bindings (lekbi.binding_count - 1).sequence = attach_data.erase_char;
 688 
 689                               lekbi.bindings (lekbi.binding_count).action = BACKWARD_DELETE_CHARACTER;
 690                               lekbi.bindings (lekbi.binding_count).sequence = editing_chars.erase;
 691 
 692                               attach_data.erase_char = editing_chars.erase;
 693                          end;
 694 
 695                          else if editing_chars.kill ^= SPACE then do;
 696                               lekbi.binding_count = lekbi.binding_count + 2;
 697 
 698 /* First unbind the previous kill char, to
 699    SELF_INSERT if it is a printing graphic or
 700    UNDEFINED if it is not. */
 701 
 702                               if (attach_data.kill_char >= SPACE) & (attach_data.kill_char < DEL) then
 703                                    lekbi.bindings (lekbi.binding_count - 1).action = SELF_INSERT;
 704                               else lekbi.bindings (lekbi.binding_count - 1).action = UNDEFINED;
 705                               lekbi.bindings (lekbi.binding_count - 1).sequence = attach_data.kill_char;
 706 
 707                               lekbi.bindings (lekbi.binding_count).action = KILL_TO_BEGINNING_OF_LINE;
 708                               lekbi.bindings (lekbi.binding_count).sequence = editing_chars.kill;
 709 
 710                               attach_data.kill_char = editing_chars.kill;
 711                          end;
 712 
 713                          /*** Use default strings for these */
 714                          lekbi.name (*), lekbi.description (*), lekbi.info_dir (*), lekbi.info_entry (*) = "";
 715 
 716                          call iox_$control (Iocb_ptr, "set_editor_key_bindings", addr (sekbi), Code);
 717 
 718                          temp_ptr = sekbi.key_binding_info_ptr;
 719                          sekbi.key_binding_info_ptr = null ();
 720                          free temp_ptr -> lekbi;
 721                     end;
 722                end;
 723           end;
 724 
 725           else if Order = "get_more_responses" then do;
 726                call check_null ();
 727                more_responses_info_ptr = Info_ptr;
 728                call require_version (more_responses_info.version, more_responses_info_version_1);
 729                more_responses_info.n_yeses = attach_data.n_yeses;
 730                more_responses_info.n_noes = attach_data.n_noes;
 731                more_responses_info.yeses = attach_data.more_yeses;
 732                more_responses_info.noes = attach_data.more_noes;
 733           end;
 734 
 735           else if Order = "set_more_responses" then do;
 736                call check_null ();
 737                more_responses_info_ptr = Info_ptr;
 738                call require_version (more_responses_info.version, more_responses_info_version_1);
 739                if search (substr (more_responses_info.yeses, 1, more_responses_info.n_yeses),
 740                     substr (more_responses_info.noes, 1, more_responses_info.n_noes)) > 0 then
 741                     Code = video_et_$overlapping_more_responses;
 742                else do;
 743                     attach_data.n_yeses = more_responses_info.n_yeses;
 744                     attach_data.n_noes = more_responses_info.n_noes;
 745                     attach_data.more_yeses = more_responses_info.yeses;
 746                     attach_data.more_noes = more_responses_info.noes;
 747                end;
 748           end;                                              /* set_more_responses */
 749 
 750           else if Order = "get_window_status" then do;      /* destructive read */
 751                call check_null ();
 752                window_status_info_ptr = Info_ptr;
 753                call require_version (window_status_info.version, window_status_version_1);
 754                string (window_status_info.status_string) = string (attach_data.status);
 755                string (attach_data.status) = "0"b;
 756                attach_data.status_pending = "0"b;
 757                return;
 758           end;
 759 
 760           else if Order = "set_window_status"               /* Interrupt */
 761           then do;                                          /* return codes from now Until doomsday */
 762                call check_null ();
 763                window_status_info_ptr = Info_ptr;
 764                call require_version (window_status_info.version, window_status_version_1);
 765                string (attach_data.status) = string (attach_data.status) | string (window_status_info.status_string);
 766                attach_data.status_pending = "1"b;
 767           end;
 768 
 769           else if Order = "start" then
 770                call iox_$control (target_iocbp, "start", null (), (0));
 771 
 772           else if Order = "set_break_table" then do;
 773                call check_null ();
 774                break_table_ptr = Info_ptr;
 775                call require_version (break_table_info.version, break_table_info_version_1);
 776                attach_data.breaks = string (break_table_info.breaks);
 777           end;
 778           else if Order = "get_break_table" then do;
 779                call check_null ();
 780                break_table_ptr = Info_ptr;
 781                call require_version (break_table_info.version, break_table_info_version_1);
 782                string (break_table_info.breaks) = attach_data.breaks;
 783           end;
 784 
 785           else if Order = "set_more_handler" then do;
 786                call check_null ();
 787                more_handler_info_ptr = Info_ptr;
 788                call require_version (more_handler_info.version, more_handler_info_version_3);
 789 
 790 /* return the old entry value if there was one */
 791                if attach_data.more_handler_in_use then do;
 792                     more_handler_info.old_more_handler = attach_data.more_handler;
 793                     more_handler_info.old_handler_valid = "1"b;
 794                end;
 795                else more_handler_info.old_handler_valid = "0"b;
 796 
 797 /* should the entry variable be verified in some way? */
 798                attach_data.more_handler = more_handler_info.more_handler;
 799                attach_data.more_handler_in_use = "1"b;
 800           end;
 801 
 802           else if Order = "get_more_handler" then do;
 803                call check_null ();
 804                more_handler_info_ptr = Info_ptr;
 805                call require_version (more_handler_info.version, more_handler_info_version_3);
 806                if ^attach_data.more_handler_in_use then do;
 807                     Code = video_et_$no_more_handler_in_use;
 808                     return;
 809                end;
 810                more_handler_info.more_handler = attach_data.more_handler;
 811                more_handler_info.old_handler_valid = "0"b;
 812                return;
 813           end;
 814 
 815           else if Order = "reset_more_handler" then
 816                attach_data.more_handler_in_use = "0"b;
 817 
 818           else if Order = "set_token_characters" then do;
 819                call check_null ();
 820                token_characters_info_ptr = Info_ptr;
 821                call require_version_str (token_characters_info.version, token_characters_info_version_1);
 822                attach_data.token_characters = token_characters_info.token_characters;
 823                attach_data.token_character_count = token_characters_info.token_character_count;
 824           end;
 825 
 826           else if Order = "get_token_characters" then do;
 827                call check_null ();
 828                token_characters_info_ptr = Info_ptr;
 829                call require_version_str (token_characters_info.version, token_characters_info_version_1);
 830                token_characters_info.token_characters = attach_data.token_characters;
 831                token_characters_info.token_character_count = attach_data.token_character_count;
 832           end;
 833 
 834           else if Order = "set_more_prompt" then do;
 835                call check_null ();
 836                more_prompt_info_ptr = Info_ptr;
 837                call require_version_str (more_prompt_info.version, more_prompt_info_version_1);
 838                attach_data.more_prompt = more_prompt_info.more_prompt;
 839           end;
 840 
 841           else if Order = "get_more_prompt" then do;
 842                call check_null ();
 843                more_prompt_info_ptr = Info_ptr;
 844                call require_version_str (more_prompt_info.version, more_prompt_info_version_1);
 845                more_prompt_info.more_prompt = attach_data.more_prompt;
 846           end;
 847 
 848           else if Order = "set_editor_key_bindings" then do;
 849                call check_null ();
 850                set_editor_key_bindings_info_ptr = Info_ptr;
 851 
 852 dcl      line_editor_key_binding_info_version_2
 853                                 char (8) int static options (constant) init ("lekbi002");
 854                                                             /* archaic version */
 855                if set_editor_key_bindings_info.version = line_editor_key_binding_info_version_2
 856                     | set_editor_key_bindings_info.version = line_editor_key_binding_info_version_3 then
 857                     call update_key_bindings (set_editor_key_bindings_info_ptr);
 858                else if set_editor_key_bindings_info.version ^= set_editor_key_bindings_info_version_1 then
 859                     call error_exit (error_table_$unimplemented_version);
 860                else if set_editor_key_bindings_info.replace = set_editor_key_bindings_info.update
 861                                                             /* exactly one may be set */
 862                     then
 863                     call error_exit (error_table_$bad_subr_arg);
 864                else if set_editor_key_bindings_info.update then
 865                     call update_key_bindings (set_editor_key_bindings_info.key_binding_info_ptr);
 866                else                                         /* if set_editor_key_bindings_info.replace */
 867                     do;
 868                     temp_ptr = attach_data.dispatch_table_ptr;
 869                     attach_data.dispatch_table_ptr = set_editor_key_bindings_info.key_binding_info_ptr;
 870                     free temp_ptr -> dispatch_table in (attach_data_area);
 871                end;
 872           end;
 873 
 874           else if Order = "get_editor_key_bindings" then do;
 875                call check_null ();
 876                get_editor_key_bindings_info_ptr = Info_ptr;
 877 
 878                call require_version_str (get_editor_key_bindings_info.version, get_editor_key_bindings_info_version_1);
 879                call require_mbz (get_editor_key_bindings_info.flags.mbz);
 880 
 881                if get_editor_key_bindings_info.entire_state then
 882                     call make_key_bindings_copy (get_editor_key_bindings_info.entire_state_ptr);
 883 
 884                else do;
 885                     line_editor_key_binding_info_ptr = get_editor_key_bindings_info.key_binding_info_ptr;
 886                     if line_editor_key_binding_info_ptr = null () then do;
 887                          call error_exit (error_table_$null_info_ptr);
 888                     end;
 889                     call require_version_str (line_editor_key_binding_info.version,
 890                          line_editor_key_binding_info_version_3);
 891 
 892 dcl      bad_prefix             condition;
 893                     on bad_prefix                           /* Signaled if he asks for the binding of a sequence */
 894                          call error_exit (error_table_$bad_subr_arg);
 895                                                             /* with an invalid prefix sequence */
 896 
 897                     do binding_index = 1 to line_editor_key_binding_info.binding_count;
 898                          call get_key_binding (line_editor_key_binding_info.sequence (binding_index),
 899                               line_editor_key_binding_info.action (binding_index),
 900                               line_editor_key_binding_info.numarg_action (binding_index),
 901                               line_editor_key_binding_info.editor_routine (binding_index),
 902                               line_editor_key_binding_info.name (binding_index),
 903                               line_editor_key_binding_info.description (binding_index),
 904                               line_editor_key_binding_info.info_path (binding_index));
 905                     end;
 906                end;
 907 
 908                return;
 909           end;
 910 
 911           else if Order = "get_output_conversion" then do;
 912 dcl      1 cts                  aligned like cv_trans_struc based (cts_ptr);
 913 dcl      cts_ptr                ptr;
 914                call check_null ();
 915                cts_ptr = Info_ptr;
 916                if ^(cts.version = 1 | cts.version = CV_TRANS_VERSION)
 917                                                             /* support both versions */
 918                then do;
 919                     Code = error_table_$unimplemented_version;
 920                     return;
 921                end;
 922                begin;
 923 dcl      index                  fixed bin;
 924                     do index = 0 to CV_TRANS_SIZE (cts.version);
 925                          cts.cv_trans.value (index) = attach_data.output_cv_ptr -> cv_trans.value (index);
 926                     end;                                    /* do */
 927                end;                                         /* begin */
 928           end;
 929 
 930           else if Order = "set_output_conversion" then do;
 931                call check_null ();
 932                cts_ptr = Info_ptr;
 933                if ^(cts.version = 1 | cts.version = CV_TRANS_VERSION)
 934                                                             /* support both versions */
 935                then do;
 936                     Code = error_table_$unimplemented_version;
 937                     return;
 938                end;
 939                if cts.default = 1 then                      /* default to what we get from terminal control */
 940                     do;
 941                     call iox_$control (target_iocbp, "get_output_conversion", cts_ptr, Code);
 942                     if Code ^= 0 then
 943                          return;
 944                end;
 945                attach_data.output_cv_ptr -> cv_trans.value (*) = OUTPUT_CONVERT_OCTAL;
 946                                                             /* anything but garbage will do */
 947                begin;
 948 dcl      index                  fixed bin;
 949                     do index = 0 to CV_TRANS_SIZE (cts.version);
 950                          attach_data.output_cv_ptr -> cv_trans.value (index) = cts.cv_trans.value (index);
 951                     end;                                    /* do */
 952                end;                                         /* begin */
 953                                                             /* Set up tct table for quick conversion scan. */
 954                begin;
 955 dcl      cv_trans_idx           fixed bin;
 956 dcl      conversion_type        fixed bin;
 957 
 958 /* Fill in first 128 entries in string from regular table. */
 959                     do cv_trans_idx = 0 to 127;
 960                          substr (attach_data.conversion_tct_table, cv_trans_idx + 1, 1) =
 961                               byte (attach_data.output_cv_ptr -> cv_trans.value (cv_trans_idx));
 962                     end;
 963 
 964 /* Now handle next 128, giving defaults if necessary. */
 965                     do cv_trans_idx = 128 to 255;
 966                          conversion_type = attach_data.output_cv_ptr -> cv_trans.value (cv_trans_idx);
 967                          if conversion_type = OUTPUT_CONVERT_ORDINARY
 968                                                             /* bull */
 969                               then
 970                               substr (attach_data.conversion_tct_table, cv_trans_idx + 1, 1) =
 971                                    byte (OUTPUT_CONVERT_OCTAL);
 972                          else substr (attach_data.conversion_tct_table, cv_trans_idx + 1, 1) = byte (conversion_type);
 973                     end;
 974 
 975 /* Now take care of things beyond limits of conversion table. */
 976                     substr (attach_data.conversion_tct_table, 257, 256) = copy (byte (OUTPUT_CONVERT_OCTAL), 256);
 977                end;                                         /* begin */
 978 
 979           end;
 980 
 981           else if Order = "get_special" then do;
 982 dcl      1 gsi                  aligned like get_special_info_struc based (Info_ptr);
 983 dcl      gsi_area               area based (gsi.area_ptr);
 984 
 985 dcl      1 gsi_old              aligned based (Info_ptr),
 986            2 area_ptr           pointer,
 987            2 table_ptr          pointer;
 988 dcl      gsi_area_old           area based (gsi_old.area_ptr);
 989 
 990                call check_null ();
 991                sc_escape_len = attach_data.special_ptr -> special_chars.escape_length;
 992                sc_input_escape_len = attach_data.special_ptr -> special_chars.input_escapes.len;
 993                if gsi.version = SPECIAL_INFO_STRUCT_VERSION_1 then do;
 994                     allocate special_chars_struc set (gsi.table_ptr) in (gsi_area);
 995                     gsi.table_ptr -> special_chars_struc.version = SPECIAL_VERSION_2;
 996                     addr (gsi.table_ptr -> special_chars_struc.special_chars) -> special_chars =
 997                          attach_data.special_ptr -> special_chars;
 998                end;
 999                else do;
1000                     allocate special_chars_struc_old set (gsi_old.table_ptr) in (gsi_area_old);
1001                     gsi_old.table_ptr -> special_chars_struc_old.version = SPECIAL_VERSION;
1002                     call copy_new_to_old_special_table;
1003                     if Code ^= 0 then do;
1004                          free gsi_old.table_ptr -> special_chars_struc_old;
1005                          gsi_old.table_ptr = null;
1006                     end;
1007                end;
1008           end;
1009 
1010           else if Order = "set_special" then do;
1011 dcl      1 scs                  aligned like special_chars_struc based (scs_ptr);
1012 dcl      scs_ptr                ptr;
1013                call check_null ();
1014                scs_ptr = Info_ptr;
1015 
1016 /* this used to be a call to require_version but since we need to allow two
1017    version numbers, it won't work any more.  We will check it inline for now */
1018                if scs.version ^= SPECIAL_VERSION & scs.version ^= SPECIAL_VERSION_2
1019                     & scs.version ^= editing_chars_version_2 then do;
1020                     call error_exit (error_table_$unimplemented_version);
1021                end;
1022                on cleanup goto FREE_SCS;
1023                if scs.default = 1 then do;                  /* default to what we get from terminal control */
1024                     begin;
1025 dcl      1 auto_gsi             like get_special_info_struc;
1026                          auto_gsi.version = SPECIAL_INFO_STRUCT_VERSION_1;
1027                          auto_gsi.area_ptr = get_system_free_area_ ();
1028                          call iox_$control (target_iocbp, "get_special", addr (auto_gsi), Code);
1029                          if Code ^= 0 then
1030                               return;
1031                          scs_ptr = auto_gsi.table_ptr;
1032                     end;                                    /* begin */
1033                end;                                         /* then do */
1034                sc_escape_len = scs.special_chars.escape_length;
1035                sc_input_escape_len = scs.special_chars.input_escapes.len;
1036                allocate special_chars set (temp_ptr);
1037                if scs.version = SPECIAL_VERSION_2 then
1038                     temp_ptr -> special_chars = addr (scs.special_chars) -> special_chars;
1039                else call copy_old_to_new_special_table;
1040                free attach_data.special_ptr -> special_chars;
1041                attach_data.special_ptr = temp_ptr;
1042 FREE_SCS:
1043                if scs_ptr ^= Info_ptr                       /* scs is what we got from terminal control, not what the user gave us */
1044                     then
1045                     free scs;
1046           end;
1047 
1048           else if Order = "read_status" then
1049                call read_status ();
1050 
1051           else if (Order = "io_call") | (Order = "io_call_af") then
1052                call process_io_call (Iocb_ptr, Order, Info_ptr, Code);
1053 
1054           else if Order = "set_audit_iocb_ptr" then
1055                attach_data.auditor_iocb_ptr = Info_ptr;
1056 
1057           else if Order = "get_audit_iocb_ptr" then
1058                Info_ptr = attach_data.auditor_iocb_ptr;
1059 
1060 /* Unrecognized at window level, try passing on to tc_. */
1061           else call iox_$control (target_iocbp, Order, Info_ptr, Code);
1062 
1063           return;
1064 ^L
1065 update_key_bindings:
1066      proc (a_info_ptr);
1067 
1068 dcl      a_info_ptr             ptr parameter;
1069 
1070           line_editor_key_binding_info_ptr = a_info_ptr;
1071 
1072           if line_editor_key_binding_info.version = line_editor_key_binding_info_version_3 then do;
1073 
1074 /* Verify that all actions are within the allowed values */
1075                do binding_index = 1 to line_editor_key_binding_info.binding_count;
1076                     if length (line_editor_key_binding_info.sequence (binding_index)) = 0 then do;
1077                          call error_exit (error_table_$bad_subr_arg);
1078                     end;
1079 
1080                     if (line_editor_key_binding_info.action (binding_index) < EXTERNAL_ROUTINE)
1081                          | (line_editor_key_binding_info.action (binding_index) > HIGHEST_BUILTIN_ROUTINE_VALUE) then do;
1082                          call error_exit (error_table_$bad_subr_arg);
1083                     end;
1084 
1085                     if (line_editor_key_binding_info.numarg_action (binding_index) < 0
1086                          | line_editor_key_binding_info.numarg_action (binding_index) > HIGHEST_NUMARG_ACTION_VALUE)
1087                          & ^(line_editor_key_binding_info.action (binding_index) = EXTERNAL_ROUTINE) then do;
1088                          call error_exit (error_table_$bad_subr_arg);
1089                     end;
1090 
1091                end;
1092 
1093 /* set individual key bindings from structure */
1094                do binding_index = 1 to line_editor_key_binding_info.binding_count;
1095                     call set_key_binding (line_editor_key_binding_info.sequence (binding_index),
1096                          line_editor_key_binding_info.action (binding_index),
1097                          line_editor_key_binding_info.numarg_action (binding_index),
1098                          line_editor_key_binding_info.editor_routine (binding_index),
1099                          line_editor_key_binding_info.name (binding_index),
1100                          line_editor_key_binding_info.description (binding_index),
1101                          line_editor_key_binding_info.info_path (binding_index));
1102                end;
1103           end;
1104 
1105           else if line_editor_key_binding_info.version = line_editor_key_binding_info_version_2 then do;
1106 dcl      1 v2lekbi              aligned based (line_editor_key_binding_info_ptr),
1107            2 version            char (8),
1108            2 binding_count      fixed bin,
1109            2 longest_sequence   fixed bin,
1110            2 bindings           (line_editor_binding_count refer (v2lekbi.binding_count)),
1111              3 sequence         char (line_editor_longest_sequence refer (v2lekbi.longest_sequence)) varying,
1112              3 action           fixed bin,
1113              3 numarg_action    fixed binary,
1114              3 editor_routine   entry (pointer, fixed bin (35));
1115 dcl      1 blank_info_path      like line_editor_key_binding_info.info_path;
1116 
1117                do binding_index = 1 to v2lekbi.binding_count;
1118                     if length (v2lekbi.sequence (binding_index)) = 0 then do;
1119                          call error_exit (error_table_$bad_subr_arg);
1120                     end;
1121 
1122                     if (v2lekbi.action (binding_index) < EXTERNAL_ROUTINE)
1123                          | (v2lekbi.action (binding_index) > HIGHEST_BUILTIN_ROUTINE_VALUE) then do;
1124                          call error_exit (error_table_$bad_subr_arg);
1125                     end;
1126 
1127                     if (v2lekbi.numarg_action (binding_index) < 0
1128                          | v2lekbi.numarg_action (binding_index) > HIGHEST_NUMARG_ACTION_VALUE)
1129                          & ^(v2lekbi.action (binding_index) = EXTERNAL_ROUTINE) then do;
1130                          call error_exit (error_table_$bad_subr_arg);
1131                     end;
1132 
1133                end;
1134 
1135                blank_info_path.info_dir, blank_info_path.info_entry = "";
1136 
1137 /* set individual key bindings from structure */
1138                do binding_index = 1 to v2lekbi.binding_count;
1139                     call set_key_binding (v2lekbi.sequence (binding_index), v2lekbi.action (binding_index),
1140                          v2lekbi.numarg_action (binding_index), v2lekbi.editor_routine (binding_index), "", "",
1141                          blank_info_path);
1142                end;
1143           end;
1144 
1145           else call error_exit (error_table_$unimplemented_version);
1146 
1147           return;
1148      end update_key_bindings;
1149 ^L
1150 set_key_binding:
1151      procedure (sequence, action, numarg_action, editor_routine, name, description, info_path);
1152 
1153 dcl      sequence               char (*) varying;
1154 dcl      action                 fixed bin;
1155 dcl      numarg_action          fixed bin;
1156 dcl      editor_routine         entry (ptr, fixed bin (35));
1157 dcl      (name, description)    char (*) varying aligned parameter;
1158 dcl      1 info_path            like line_editor_key_binding_info.info_path parameter;
1159 
1160 dcl      char                   char (1) aligned;
1161 dcl      char_fix               fixed bin (9);
1162 dcl      char_index             fixed bin;
1163 dcl      old_ptr                pointer;
1164 dcl      new_ptr                pointer;
1165 
1166 dcl      window_io_iox_$free_dispatch_tables
1167                                 entry (ptr);
1168 
1169 dcl      PREFIX                 fixed bin static options (constant) init (-1);
1170 
1171           char = substr (sequence, 1, 1);
1172 
1173 /* If we are setting a single self-insert character, make sure that
1174    it can be echo negotiated */
1175           if (action = SELF_INSERT) & (length (sequence) = 1) & (char >= SPACE) & (char < DEL) then
1176                call set_break_table (char, "0"b);
1177           else call set_break_table (char, "1"b);
1178 
1179           old_ptr = attach_data.dispatch_table_ptr;
1180 
1181 /* loop through first characters setting up prefix tables. */
1182           do char_index = 1 to length (sequence) - 1;
1183                char_fix = rank (substr (sequence, char_index, 1));
1184 
1185 /* If char is not already a prefix, allocate new table. */
1186                if old_ptr -> dispatch_table.key (char_fix).type >= 0 then do;
1187                     allocate dispatch_table set (new_ptr);
1188                     new_ptr -> dispatch_table.key (*).type = UNDEFINED;
1189                                                             /* chain it in to current table */
1190                     old_ptr -> dispatch_table.key (char_fix).next_table = new_ptr;
1191                     old_ptr -> dispatch_table.key (char_fix).type = PREFIX;
1192                end;
1193                old_ptr = old_ptr -> dispatch_table.key (char_fix).next_table;
1194           end;
1195 
1196           char_fix = rank (substr (sequence, length (sequence), 1));
1197 
1198 /* If a prefix turns into a leaf, free the old dispatch table */
1199           if old_ptr -> dispatch_table.key (char_fix).type = PREFIX then
1200                call window_io_iox_$free_dispatch_tables (old_ptr -> dispatch_table.key (char_fix).next_table);
1201 
1202 /* Set the specified dispatch table entry. */
1203           old_ptr -> dispatch_table.key (char_fix).type = action;
1204 
1205           if action = EXTERNAL_ROUTINE then do;
1206                old_ptr -> dispatch_table.key (char_fix).routine = editor_routine;
1207                old_ptr -> dispatch_table.key (char_fix).numarg_action = numarg_action;
1208           end;
1209           old_ptr -> dispatch_table.key (char_fix).name = name;
1210           old_ptr -> dispatch_table.key (char_fix).description = description;
1211           old_ptr -> dispatch_table.key (char_fix).info_path = info_path;
1212 
1213           return;
1214 ^L
1215 get_key_binding:
1216      entry (sequence, action, numarg_action, editor_routine, name, description, info_path);
1217 
1218           old_ptr = attach_data.dispatch_table_ptr;
1219 
1220           do char_index = 1 to length (sequence) - 1;
1221                char_fix = rank (substr (sequence, char_index, 1));
1222 
1223 /* If char is not a prefix then complain */
1224                if old_ptr -> dispatch_table.key (char_fix).type >= 0 then
1225                     signal bad_prefix;
1226 
1227                old_ptr = old_ptr -> dispatch_table.key (char_fix).next_table;
1228           end;
1229 
1230           char_fix = rank (substr (sequence, length (sequence), 1));
1231           action = old_ptr -> dispatch_table.key (char_fix).type;
1232 
1233           if action = EXTERNAL_ROUTINE then do;
1234                editor_routine = old_ptr -> dispatch_table.key (char_fix).routine;
1235                numarg_action = old_ptr -> dispatch_table.key (char_fix).numarg_action;
1236           end;
1237           if length (old_ptr -> dispatch_table.key (char_fix).name) = 0 then
1238                name = builtin_routine_names (max (action, lbound (builtin_routine_names, 1)));
1239           else name = old_ptr -> dispatch_table.key (char_fix).name;
1240           if length (old_ptr -> dispatch_table.key (char_fix).description) = 0 then
1241                description = builtin_descriptions (max (action, lbound (builtin_descriptions, 1)));
1242           else description = old_ptr -> dispatch_table.key (char_fix).description;
1243           if old_ptr -> dispatch_table.key (char_fix).info_entry = "" then do;
1244                if action = EXTERNAL_ROUTINE then do;
1245                     info_path.info_entry = "";
1246                     info_path.info_dir = "";
1247                end;
1248                else do;
1249                     info_path.info_entry = BUILTIN_INFO_ENTRY;
1250                     info_path.info_dir = BUILTIN_INFO_DIR;
1251                end;
1252           end;
1253           else info_path = old_ptr -> dispatch_table.key (char_fix).info_path;
1254 
1255           return;
1256 
1257      end set_key_binding;
1258 ^L
1259 make_key_bindings_copy:
1260      procedure (new_ptr);
1261 
1262 dcl      new_ptr                ptr;                        /* (output) points to a copy of the dispatch table hierarchy */
1263 
1264           call copy_dispatch_table (attach_data.dispatch_table_ptr, new_ptr);
1265           return;
1266 
1267 copy_dispatch_table:
1268           procedure (old_ptr, new_ptr);
1269 
1270 dcl      (old_ptr, new_ptr)     ptr;
1271 
1272 dcl      key_num                fixed bin;
1273 
1274                allocate dispatch_table in (attach_data_area) set (new_ptr);
1275                new_ptr -> dispatch_table = old_ptr -> dispatch_table;
1276                do key_num = lbound (old_ptr -> dispatch_table.key, 1) to hbound (old_ptr -> dispatch_table.key, 1);
1277                     if old_ptr -> dispatch_table.key (key_num).type < 0 then
1278                          call copy_dispatch_table (old_ptr -> dispatch_table.key (key_num).next_table,
1279                               new_ptr -> dispatch_table.key (key_num).next_table);
1280                end;
1281 
1282                return;
1283 
1284           end copy_dispatch_table;
1285 
1286      end make_key_bindings_copy;
1287 ^L
1288 process_io_call:
1289      procedure (io_call_iocb, io_call_order, io_call_infop, code);
1290 
1291 dcl      io_call_iocb           pointer parameter;
1292 dcl      io_call_order          char (*) parameter;
1293 dcl      code                   fixed bin (35) parameter;
1294 
1295 %include io_call_info;
1296 
1297 dcl      iocb_ptr               pointer;
1298 dcl      order                  char (32);
1299 dcl      caller                 char (32);
1300 dcl      called_as_af           bit (1);
1301 dcl      i                      fixed bin;
1302 dcl      arg_index              fixed bin;
1303 dcl      entry_name             char (65);                  /* 32 + 1 + 32 */
1304 
1305 dcl      1 MHI                  aligned like more_handler_info;
1306 dcl      1 MRI                  aligned like more_responses_info;
1307 dcl      1 MPI                  aligned like more_prompt_info;
1308 dcl      1 TCI                  aligned like token_characters_info;
1309 dcl      1 WSI                  aligned like window_status_info;
1310 dcl      1 EC                   aligned like editing_chars;
1311 
1312 dcl      error_table_$wrong_no_of_args
1313                                 fixed bin (35) external;
1314 dcl      error_table_$undefined_order_request
1315                                 fixed bin (35) external;
1316 dcl      error_table_$noarg     fixed bin (35) external;
1317 dcl      error_table_$bad_arg   fixed bin (35) external;
1318 dcl      error_table_$badopt    fixed bin (35) external;
1319 
1320 dcl      cv_entry_              entry (char (*), ptr, fixed bin (35)) returns (entry);
1321 
1322           code = 0;
1323 
1324           iocb_ptr = io_call_iocb -> iocb.actual_iocb_ptr;
1325 
1326           if io_call_order = "io_call" then
1327                called_as_af = "0"b;
1328           else do;
1329                called_as_af = "1"b;
1330                io_call_af_ret = "";
1331           end;
1332 
1333           order = io_call_info.order_name;
1334           caller = io_call_info.caller_name;
1335 
1336           if order = "set_more_handler" then do;
1337                if io_call_info.nargs = 0 then do;
1338                     call io_call_info.error (0, "", "usage: io_call control window_switch set_more_handler more_handler");
1339                     return;
1340                end;
1341                if io_call_info.nargs > 1 then do;
1342                     call io_call_info
1343                          .
1344                          error (error_table_$wrong_no_of_args, caller, "Only one more handler name may be specified. ^a",
1345                          order);
1346                     return;
1347                end;
1348 
1349                MHI.version = more_handler_info_version_3;
1350                MHI.more_handler = cv_entry_ ((io_call_info.args (1)), codeptr (process_io_call), code);
1351                if code ^= 0 then do;
1352                     call io_call_info
1353                          .
1354                          error (code, caller, "Could not covert ""^a"" to an entry value. ^a", io_call_info.args (1),
1355                          order);
1356                     code = 0;
1357                     return;
1358                end;
1359                call iox_$control (iocb_ptr, order, addr (MHI), code);
1360                if code ^= 0 then
1361                     call io_call_info.error (code, caller, "While setting more handler. ^a", order);
1362                code = 0;
1363                return;
1364           end;
1365 
1366           else if order = "get_more_handler" then do;
1367                call io_call_require_no_args ();
1368                MHI.version = more_handler_info_version_3;
1369                call iox_$control (iocb_ptr, order, addr (MHI), code);
1370                if code ^= 0 & code ^= video_et_$no_more_handler_in_use then do;
1371                     call io_call_info.error (code, caller, "While getting more handler. ^a", order);
1372                     code = 0;
1373                     return;
1374                end;
1375                if code = video_et_$no_more_handler_in_use then do;
1376                     if called_as_af then
1377                          call ioa_$rsnnl ("NONE", io_call_af_ret, (0));
1378                     else call io_call_info.report ("No more handler in use.");
1379                     code = 0;
1380                     return;
1381                end;
1382                call entry_var_to_string (MHI.more_handler, entry_name, code);
1383                if code ^= 0 then do;
1384                     call io_call_info.error (code, caller, "While getting name of more handler. ^a", order);
1385                     code = 0;
1386                     return;
1387                end;
1388                if called_as_af then
1389                     call ioa_$rsnnl ("^a", io_call_af_ret, (0), rtrim (entry_name));
1390                else call io_call_info.report ("More handler: ^a", rtrim (entry_name));
1391                return;
1392           end;
1393 
1394           else if order = "set_more_responses" then do;
1395                if io_call_info.nargs = 0 then do;
1396                     call io_call_info
1397                          .
1398                          error (0, "",
1399                          "usage: io_call control window_switch set_more_responses yes_responses no_responses");
1400                     return;
1401                end;
1402                if io_call_info.nargs < 2 then do;
1403                     call io_call_info
1404                          .
1405                          error (error_table_$wrong_no_of_args, caller, "Both yes and no responses must be specified. ^a",
1406                          order);
1407                     return;
1408                end;
1409                if io_call_info.nargs > 2 then do;
1410                     call io_call_info
1411                          .
1412                          error (error_table_$wrong_no_of_args, caller,
1413                          "Only one yes response string and one no response string may be specified. ^a", order);
1414                     return;
1415                end;
1416                MRI.version = more_responses_info_version_1;
1417                MRI.n_yeses = length (io_call_info.args (1));
1418                MRI.yeses = io_call_info.args (1);
1419                MRI.n_noes = length (io_call_info.args (2));
1420                MRI.noes = io_call_info.args (2);            /* rely on real control order to validate responses */
1421                call iox_$control (iocb_ptr, order, addr (MRI), code);
1422                if code ^= 0 then
1423                     call io_call_info.error (code, caller, "While setting more responses. ^a", order);
1424                code = 0;
1425                return;
1426           end;
1427 
1428           else if order = "get_more_responses" then do;
1429                call io_call_require_no_args ();
1430                MRI.version = more_responses_info_version_1;
1431                call iox_$control (iocb_ptr, order, addr (MRI), code);
1432                if code ^= 0 then do;
1433                     call io_call_info.error (code, caller, "While getting more repsonses. ^a", order);
1434                     code = 0;
1435                     return;
1436                end;
1437                if called_as_af then
1438                     call ioa_$rsnnl ("^a ^a", io_call_af_ret, (0), substr (MRI.yeses, 1, MRI.n_yeses),
1439                          substr (MRI.noes, 1, MRI.n_noes));
1440                else do;
1441 dcl      (yeses, noes)          char (255) varying init ("");
1442                     do i = 1 to max (MRI.n_yeses, MRI.n_noes);
1443                          if i <= MRI.n_yeses then
1444                               yeses = yeses || flat_rep (substr (MRI.yeses, i, i + 1)) || " ";
1445                          if i <= MRI.n_noes then
1446                               noes = noes || flat_rep (substr (MRI.noes, i, i + 1)) || " ";
1447                     end;                                    /* do loop */
1448                     call io_call_info
1449                          .
1450                          report ("Yes Response^[s^]: ""^a""  No Response^[s^]: ""^a""", MRI.n_yeses > 1, yeses,
1451                          MRI.n_noes > 1, noes);
1452                end;
1453                return;
1454           end;
1455 
1456           else if order = "set_more_prompt" then do;
1457                if io_call_info.nargs = 0 then do;
1458                     call io_call_info.error (0, "", "usage: io_call control window_switch set_more_prompt prompt_string");
1459                     return;
1460                end;
1461                if io_call_info.nargs > 1 then do;
1462                     call io_call_info
1463                          .
1464                          error (error_table_$wrong_no_of_args, caller, "Only one more prompt string may be specified. ^a",
1465                          order);
1466                     return;
1467                end;
1468                MPI.version = more_prompt_info_version_1;
1469                MPI.more_prompt = io_call_info.args (1);
1470                call iox_$control (iocb_ptr, order, addr (MPI), code);
1471                if code ^= 0 then
1472                     call io_call_info.error (code, caller, "While setting more prompt. ^a", order);
1473                code = 0;
1474                return;
1475           end;
1476 
1477           else if order = "get_more_prompt" then do;
1478                call io_call_require_no_args ();
1479                MPI.version = more_prompt_info_version_1;
1480                call iox_$control (iocb_ptr, order, addr (MPI), code);
1481                if code ^= 0 then do;
1482                     call io_call_info.error (code, caller, "While getting more prompt. ^a", order);
1483                     code = 0;
1484                     return;
1485                end;
1486                if called_as_af then
1487                     call ioa_$rsnnl ("^a", io_call_af_ret, (0), MPI.more_prompt);
1488                else call io_call_info.report ("More prompt: ""^a""", MPI.more_prompt);
1489                return;
1490           end;
1491 
1492 
1493           else if order = "set_editor_key_bindings" then do;
1494                if io_call_info.nargs = 0 then do;
1495 binding_usage:
1496                     call io_call_info
1497                          .
1498                          error (0, "",
1499                          "usage: io_call control window_switch set_editor_key_bindings character_sequence1 {editor_routine1} {control_args_1} ... {character_sequenceN {editor_routineN} {control_argsN}}"
1500                          );
1501                     return;
1502                end;
1503 
1504 /* Prepare to build args structure. */
1505 /* Pass one, count number bindings and get max length,
1506    don't validate args at all */
1507 
1508                line_editor_binding_count = 0;
1509                line_editor_longest_sequence = 0;
1510 
1511                call count_key_binding_args (1 /* arg_index */, line_editor_binding_count, line_editor_longest_sequence);
1512 
1513                if line_editor_binding_count = 0 | line_editor_longest_sequence = 0 then
1514                     goto binding_usage;                     /* must not know what's going on */
1515 
1516                allocate line_editor_key_binding_info set (line_editor_key_binding_info_ptr);
1517                on cleanup free line_editor_key_binding_info;
1518 
1519                line_editor_key_binding_info.version = line_editor_key_binding_info_version_3;
1520 
1521 /* Fill in the individual bindings. */
1522 /* now check the control arg validity */
1523 
1524                call process_key_bindings (1 /* arg_index */, 1 /* binding_index */);
1525 
1526                call iox_$control (iocb_ptr, order, line_editor_key_binding_info_ptr, code);
1527                revert cleanup;
1528                free line_editor_key_binding_info;
1529                if code ^= 0 then
1530                     call io_call_info.error (code, caller, "While setting key bindings. ^a", order);
1531                code = 0;
1532                return;
1533           end;
1534 
1535           else if order = "get_editor_key_bindings" then do;
1536                if io_call_info.nargs ^= 1 then do;
1537                     call io_call_info
1538                          .
1539                          error (0, "", "usage: io_call control window_switch get_editor_key_bindings character_sequence");
1540                     call error_exit (Code);
1541                end;
1542                begin;
1543 dcl      1 gekbi                aligned like get_editor_key_bindings_info;
1544 dcl      1 lekbi                aligned like line_editor_key_binding_info based (gekbi.key_binding_info_ptr);
1545 
1546                     gekbi.version = get_editor_key_bindings_info_version_1;
1547                     string (gekbi.flags) = ""b;
1548                     gekbi.key_binding_info_ptr = null ();
1549                     line_editor_binding_count = 1;
1550                     line_editor_longest_sequence = length (io_call_info.args (1));
1551                     on cleanup
1552                          begin;
1553                          if gekbi.key_binding_info_ptr = null () then
1554                               free line_editor_key_binding_info in (attach_data_area);
1555                     end;
1556                     allocate lekbi in (attach_data_area);
1557 
1558                     lekbi.version = line_editor_key_binding_info_version_3;
1559                     lekbi.sequence (1) = io_call_info.args (1);
1560 
1561                     call iox_$control (iocb_ptr, order, addr (gekbi), code);
1562                     if code ^= 0 then do;
1563                          call io_call_info
1564                               .
1565                               error (code, caller, "Getting the binding of ^a. ^a",
1566                               requote_string_ ((io_call_info.args (1))), order);
1567                          return;
1568                     end;
1569 
1570 dcl      routine_pathname       char (256);
1571                     if lekbi.action (1) = EXTERNAL_ROUTINE then do;
1572                          call entry_var_to_string (lekbi.editor_routine (1), routine_pathname, code);
1573                          if code ^= 0 then
1574                               return;
1575                     end;
1576 
1577 /* Note, numarg actions for builtins are only defined in window_io_iox_,
1578    so we don't return them here.  There should be a way to get at them. */
1579 
1580                     if called_as_af then do;                /* it is easier to get right this way, rather than to have one really hairy ioa_$rsnnl ... */
1581                          if lekbi.action (1) = EXTERNAL_ROUTINE then
1582                               call ioa_$rsnnl ("^a ^a -numarg_action ^a -name ^a -description ^a ^[-info_pathname ^a]",
1583                                    io_call_af_ret, (0), requote_string_ ((lekbi.sequence (1))),
1584                                    requote_string_ (rtrim (routine_pathname)),
1585                                    numarg_action_names (lekbi.numarg_action (1)),
1586                                    requote_string_ (rtrim (lekbi.name (1))),
1587                                    requote_string_ (rtrim (lekbi.description (1))),
1588                                    (lekbi.info_entry (1) ^= "") /* empty path? */,
1589                                    requote_string_ (rtrim (pathname_ (lekbi.info_dir (1), lekbi.info_entry (1)))));
1590                          else if lekbi.action (1) > EXTERNAL_ROUTINE then
1591                                                             /* a builtin */
1592                               call ioa_$rsnnl ("^a -builtin ^a -description ^a^[ -info_pathname ^a^]", io_call_af_ret,
1593                                    (0), lekbi.sequence (1), builtin_routine_names (lekbi.action (1)),
1594                                    requote_string_ (rtrim (lekbi.description (1))),
1595                                    (lekbi.info_entry (1) ^= "") /* empty path? */,
1596                                    requote_string_ (rtrim (pathname_ (lekbi.info_dir (1), lekbi.info_entry (1)))));
1597                          else                               /* a prefix key, for sure */
1598                               call ioa_$rsnnl ("^a -name PREFIX -description ^a", io_call_af_ret, (0),
1599                                    requote_string_ ((lekbi.sequence (1))),
1600                                    requote_string_ (rtrim (lekbi.description (1))));
1601                     end;                                    /* case for AF */
1602 
1603                     else call io_call_info
1604                               .
1605                               report (
1606                               "Sequence: ^a^/    ^[Num-arg action: ^a^/    Procedure: ^a^/    ^;^2s^]Name: ^a^/    Description: ^a^[^/    Info path: ^a^]",
1607                               flat_rep_string (lekbi.sequence (1)), (lekbi.action (1) = EXTERNAL_ROUTINE),
1608                               numarg_action_names (lekbi.numarg_action (1)), routine_pathname, lekbi.name (1),
1609                               lekbi.description (1), (lekbi.info_entry (1) ^= "") /* no path supplied */,
1610                               pathname_ (lekbi.info_dir (1), lekbi.info_entry (1)));
1611 
1612                     revert cleanup;
1613                     free lekbi in (attach_data_area);
1614                end;
1615                code = 0;
1616                return;
1617           end;
1618 
1619           else if order = "set_token_characters" then do;
1620                if io_call_info.nargs = 0 then do;
1621                     call io_call_info
1622                          .
1623                          error (0, "", "usage: io_call control window_switch set_token_characters token_character_string")
1624                          ;
1625                     return;
1626                end;
1627                if io_call_info.nargs > 1 then do;
1628                     call io_call_info
1629                          .
1630                          error (error_table_$wrong_no_of_args, caller,
1631                          "Only one string of token characters may be specified. ^a", order);
1632                     return;
1633                end;
1634 
1635                TCI.version = token_characters_info_version_1;
1636                TCI.token_character_count = length (io_call_info.args (1));
1637                TCI.token_characters = io_call_info.args (1);
1638 
1639                call iox_$control (iocb_ptr, order, addr (TCI), code);
1640                if code ^= 0 then
1641                     call io_call_info.error (code, caller, "While setting token characters. ^a", order);
1642                code = 0;
1643                return;
1644           end;
1645 
1646           else if order = "get_token_characters" then do;
1647                call io_call_require_no_args ();
1648                TCI.version = token_characters_info_version_1;
1649                call iox_$control (iocb_ptr, order, addr (TCI), code);
1650                if code ^= 0 then do;
1651                     call io_call_info.error (code, caller, "While getting token characters. ^a", order);
1652                     code = 0;
1653                     return;
1654                end;
1655                if called_as_af then
1656                     io_call_af_ret = substr (TCI.token_characters, 1, TCI.token_character_count);
1657                else call io_call_info.report ("^a", substr (TCI.token_characters, 1, TCI.token_character_count));
1658                return;
1659           end;
1660 
1661           else if order = "get_window_status" then do;
1662                call io_call_require_no_args ();
1663                WSI.version = window_status_version_1;
1664                call iox_$control (iocb_ptr, order, addr (WSI), code);
1665                if code ^= 0 then do;
1666                     call io_call_info.error (code, caller, "While getting window status. ^a", order);
1667                     code = 0;
1668                     return;
1669                end;
1670                if called_as_af then do;
1671                     if (WSI.status_string = ""b) then
1672                          io_call_af_ret = "NONE";
1673                     else call ioa_$rsnnl ("^[SCREEN_INVALID ^]^[ASYNC_CHANGE ^]^[TTP_CHANGE ^]^[RECONNECTION^]",
1674                               io_call_af_ret, (0), (WSI.status_string & W_STATUS_SCREEN_INVALID),
1675                               (WSI.status_string & W_STATUS_ASYNC_EVENT), (WSI.status_string & W_STATUS_TTP_CHANGE),
1676                               (WSI.status_string & W_STATUS_RECONNECTION));
1677                end;
1678                else call io_call_info
1679                          .
1680                          report (
1681                          "There was ^[no ^]^[screen_invalid ^]^[async_change ^]^[ttp_change ^]^[reconnection ^]status pending for the window.",
1682                          (WSI.status_string = ""b), (WSI.status_string & W_STATUS_SCREEN_INVALID),
1683                          (WSI.status_string & W_STATUS_ASYNC_EVENT), (WSI.status_string & W_STATUS_TTP_CHANGE),
1684                          (WSI.status_string & W_STATUS_RECONNECTION));
1685                return;
1686           end;
1687 
1688           else if order = "set_window_status" then do;
1689                if io_call_info.nargs = 0 then do;
1690                     call io_call_info
1691                          .error (0, "", "usage: io control window_switch set_window_status status_key_1 {status_key_2}");
1692                     return;
1693                end;
1694                WSI.version = window_status_version_1;
1695                do arg_index = 1 to io_call_info.nargs;
1696                     if io_call_info.args (arg_index) = "screen_invalid" then
1697                          WSI.status_string = WSI.status_string | W_STATUS_SCREEN_INVALID;
1698                     else if io_call_info.args (arg_index) = "asynchronous_change"
1699                          | io_call_info.args (arg_index) = "async_change" then
1700                          WSI.status_string = WSI.status_string | W_STATUS_ASYNC_EVENT;
1701                     else if io_call_info.args (arg_index) = "terminal_type_change"
1702                          | io_call_info.args (arg_index) = "ttp_change" then
1703                          WSI.status_string = WSI.status_string | W_STATUS_TTP_CHANGE;
1704                     else if io_call_info.args (arg_index) = "reconnection" then
1705                          WSI.status_string = WSI.status_string | W_STATUS_RECONNECTION;
1706                     else do;
1707                          call io_call_info
1708                               .
1709                               error (error_table_$bad_arg, caller,
1710                               "Only screen_invalid or asynchronous_change is allowed, not ""^a."" ^a",
1711                               io_call_info.args (arg_index), order);
1712                          return;
1713                     end;
1714                end;                                         /* do loop */
1715                call iox_$control (iocb_ptr, order, addr (WSI), code);
1716                return;
1717           end;
1718 
1719 /* this is a bit much for a pretty worthless control order (after all
1720    there is stty -edit), but if we're going to do it, let's do it right */
1721 
1722           else if order = "set_editing_chars" then do;
1723                if io_call_info.nargs = 0 then do;
1724                     call io_call_info
1725                          .error (0, "", "usage: io_call control window_switch set_editing_chars erase_kill_characters");
1726                     return;
1727                end;
1728                if io_call_info.nargs > 1 then do;
1729                     call io_call_info
1730                          .
1731                          error (error_table_$wrong_no_of_args, caller,
1732                          "Only one set of editing characters may be specified. ^a", order);
1733                     return;
1734                end;
1735                if length (io_call_info.args (1)) < 2 then do;
1736                     call io_call_info
1737                          .
1738                          error (error_table_$bad_arg, caller, "Both erase and kill characters must be specified. ^a",
1739                          order);
1740                     return;
1741                end;
1742                if length (io_call_info.args (1)) > 3 then do;
1743                     call io_call_info
1744                          .
1745                          error (error_table_$bad_arg, caller,
1746                          "Only one erase character, one kill character and one redisplay character may be specified. ^a",
1747                          order);
1748                     return;
1749                end;
1750                EC.erase = substr (io_call_info.args (1), 1, 1);
1751                EC.kill = substr (io_call_info.args (1), 2, 1);
1752                if length (io_call_info.args (1)) = 3 then do;
1753                     EC.version = editing_chars_version_3;
1754                     EC.redisplay = substr (io_call_info.args (1), 3, 1);
1755                end;
1756                else do;
1757                     EC.version = editing_chars_version_2;
1758                     EC.redisplay = "";
1759                end;
1760 
1761                call iox_$control (iocb_ptr, order, addr (EC), code);
1762                if code ^= 0 then
1763                     call io_call_info.error (code, caller, "While setting editing characters. ^a", order);
1764                return;
1765           end;
1766 
1767           else if order = "get_editing_chars" then do;
1768                call io_call_require_no_args ();
1769                EC.version = editing_chars_version_3;
1770                call iox_$control (iocb_ptr, order, addr (EC), code);
1771                if code ^= 0 then
1772                     return;
1773                if called_as_af then
1774                     call ioa_$rsnnl ("^a^a^a", io_call_af_ret, (0), EC.erase, EC.kill, EC.redisplay);
1775                else call io_call_info
1776                          .
1777                          report ("Erase: ^a, Kill: ^a, Redisplay: ^a", flat_rep (EC.erase), flat_rep (EC.kill),
1778                          flat_rep (EC.redisplay));
1779                return;
1780           end;
1781 
1782           code = error_table_$undefined_order_request;
1783           return;
1784 
1785 io_call_require_no_args:
1786           procedure;
1787 
1788                if io_call_info.nargs ^= 0 then do;
1789                     call io_call_info
1790                          .
1791                          error (error_table_$wrong_no_of_args, caller, "No arguments are allowed for the ^a order.",
1792                          order);
1793                     call error_exit (Code);
1794                end;
1795           end io_call_require_no_args;
1796 ^L
1797 /* Count the number of args (and longest key sequence) for
1798    set_editor_key_bindings, so we can allocate the
1799    line_editor_key_binding_structure (refer extents).
1800    The only validity checking done here is to ensure that a reasonable
1801    number of arguments were given (i.e. we catch "\033 foo \034", here
1802    and complain about now editor routine for \034), but all other
1803    checking is done later. */
1804 
1805 /* We get called once for each key binding to be set, thus we know that
1806    arg_index will always start pointing at the key sequence */
1807 
1808 count_key_binding_args:
1809           procedure (arg_index, binding_count, longest_key_sequence);
1810 
1811 dcl      arg_index              fixed bin,
1812          binding_count          fixed bin,
1813          longest_key_sequence   fixed bin;
1814 
1815 dcl      ctl_arg_flag           bit (1);
1816 
1817                do while (arg_index <= io_call_info.nargs);
1818 
1819                     if arg_index = io_call_info.nargs then do;
1820                          if index (io_call_info.args (arg_index), "-") = 1 then
1821                               return;
1822                          call io_call_info
1823                               .
1824                               error (error_table_$noarg, caller,
1825                               "Editor routine for character sequence ""^a"" must be specified.",
1826                               io_call_info.args (arg_index));
1827                          call error_exit (Code);
1828                     end;
1829 
1830                     longest_key_sequence = max (length (io_call_info.args (arg_index)), longest_key_sequence);
1831                     binding_count = binding_count + 1;
1832 
1833                     arg_index = arg_index + 1;
1834 
1835                     if index (io_call_info.args (arg_index), "-") ^= 1 then
1836                          arg_index = arg_index + 1;         /* skip over external routine name */
1837 
1838 /* skip over any control args (-control_arg arg), -control_arg -control_arg
1839    will squeak by here but will be caught later */
1840 
1841                     if arg_index <= io_call_info.nargs then
1842                          if index (io_call_info.args (arg_index), "-") = 1 then do;
1843                               ctl_arg_flag = "1"b;
1844                               do while (ctl_arg_flag);
1845                                    arg_index = arg_index + 2;
1846                                    if arg_index < io_call_info.nargs then
1847                                         ctl_arg_flag = (index (io_call_info.args (arg_index), "-") = 1);
1848                                    else ctl_arg_flag = "0"b;
1849                               end;                          /* do while */
1850                          end;
1851 
1852                end;                                         /* main do while loop */
1853 
1854                return;
1855 
1856           end count_key_binding_args;
1857 ^L
1858 /* fill in line_editor_key_binding_info */
1859 
1860 process_key_bindings:
1861           procedure (arg_index, binding_index);
1862 
1863 dcl      arg_index              fixed bin;
1864 dcl      binding_index          fixed bin;
1865 
1866 dcl      1 flags                aligned,
1867            2 builtin_given      unaligned bit (1),
1868            2 external_given     unaligned bit (1),
1869            2 numarg_action_given
1870                                 unaligned bit (1);
1871 
1872                do while (arg_index <= io_call_info.nargs);
1873 
1874                     unspec (flags) = ""b;
1875 
1876 /* copy the sequence directly from the command line */
1877                     line_editor_key_binding_info.sequence (binding_index) = io_call_info.args (arg_index);
1878 
1879                     /*** Initialize the strings to blanks ***/
1880                     line_editor_key_binding_info.name, line_editor_key_binding_info.description,
1881                          line_editor_key_binding_info.info_dir, line_editor_key_binding_info.info_entry = "";
1882 
1883                     arg_index = arg_index + 1;
1884 
1885                     if index (io_call_info.args (arg_index), "-") ^= 1 then do;
1886                          line_editor_key_binding_info.action (binding_index) = EXTERNAL_ROUTINE;
1887                                                             /* convert the companion arg to an entry */
1888                          line_editor_key_binding_info.editor_routine (binding_index) =
1889                               cv_entry_ ((io_call_info.args (arg_index)), codeptr (process_io_call), code);
1890                          if code ^= 0 then do;
1891                               call io_call_info
1892                                    .
1893                                    error (code, caller, "Could not convert ""^a"" to an entry value. ^a",
1894                                    io_call_info.args (arg_index), order);
1895                               code = 0;
1896                               call error_exit (Code);
1897                          end;
1898                          external_given = "1"b;
1899                          builtin_given = "0"b;
1900                          arg_index = arg_index + 1;         /* fall through to check for control args for this external editor request */
1901                     end;
1902 
1903                     if arg_index <= io_call_info.nargs then
1904                          if index (io_call_info.args (arg_index), "-") = 1 then
1905                                                             /* a control arg */
1906                               call process_control_args (arg_index, binding_index);
1907 
1908                     if ^(builtin_given | external_given) then do;
1909                          call io_call_info
1910                               .
1911                               error (error_table_$noarg, caller,
1912                               "Editor routine for character sequence ""^a"" must be specified. ^a",
1913                               line_editor_key_binding_info.sequence (binding_index), order);
1914                          call error_exit (Code);
1915                     end;
1916 
1917                     if builtin_given & numarg_action_given then do;
1918                          call io_call_info
1919                               .
1920                               error (error_table_$inconsistent, caller,
1921                               "Numarg action may not be specified for builtin routines. ^a", order);
1922                          call error_exit (Code);
1923                     end;
1924 
1925                     if ^numarg_action_given & external_given then
1926                          line_editor_key_binding_info.numarg_action (binding_index) = PASS;
1927 
1928                     binding_index = binding_index + 1;
1929 
1930                end;                                         /* do while */
1931 
1932                return;
1933 ^L
1934 /* Process control args for set_editor_key_bindings.
1935    arg_index will be left set to the next non-control arg */
1936 
1937 process_control_args:
1938                procedure (arg_index, binding_index);
1939 
1940 dcl      arg_index              fixed bin;
1941 dcl      binding_index          fixed bin;
1942 dcl      builtin_index          fixed bin;
1943 dcl      numarg_index           fixed bin;
1944 dcl      arg                    char (arg_len) varying based (arg_ptr);
1945 dcl      next_arg               char (next_arg_len) varying based (next_arg_ptr);
1946 dcl      (arg_len, next_arg_len)
1947                                 fixed bin (21);
1948 dcl      (arg_ptr, next_arg_ptr)
1949                                 ptr;
1950 dcl      found                  bit (1);
1951 
1952 dcl      uppercase              char (26) static options (constant) init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ");
1953 dcl      lowercase              char (26) static options (constant) init ("abcdefghijklmnopqrstuvwxyz");
1954 dcl      expand_pathname_$add_suffix
1955                                 entry (char (*), char (*), char (*), char (*), fixed bin (35));
1956 
1957                     do while (arg_index <= io_call_info.nargs);
1958 
1959                          arg_ptr = addr (io_call_info.args (arg_index));
1960                          arg_len = length (io_call_info.args (arg_index));
1961 
1962                          if index (arg, "-") ^= 1 then
1963                               return;                       /* done with control args for this key binding */
1964 
1965                          if ^(arg = "-builtin" | arg = "-external" | arg = "-numarg_action" | arg = "-name"
1966                               | arg = "-description" | arg = "-info_pathname") then do;
1967                               call io_call_info.error (error_table_$badopt, caller, "^a. ^a", arg, order);
1968                               call error_exit (Code);
1969                          end;
1970 
1971                          if arg_index = io_call_info.nargs then do;
1972                               call io_call_info
1973                                    .error (error_table_$noarg, caller, """^a"" requires an argument. ^a", arg, order);
1974                               call error_exit (Code);
1975                          end;
1976 
1977                          next_arg_ptr = addr (io_call_info.args (arg_index + 1));
1978                          next_arg_len = length (io_call_info.args (arg_index + 1));
1979 
1980                          if arg = "-external" then do;
1981                               line_editor_key_binding_info.action (binding_index) = EXTERNAL_ROUTINE;
1982                                                             /* convert the companion arg to an entry */
1983                               line_editor_key_binding_info.editor_routine (binding_index) =
1984                                    cv_entry_ ((next_arg), codeptr (process_io_call), code);
1985                               if code ^= 0 then do;
1986                                    call io_call_info
1987                                         .
1988                                         error (code, caller, "Could not convert ""^a"" to an entry value. ^a", next_arg,
1989                                         order);
1990                                    code = 0;
1991                                    call error_exit (Code);
1992                               end;
1993                               external_given = "1"b;
1994                               builtin_given = "0"b;
1995                          end;
1996 
1997 /* We assume that builtin names are all uppercase, and we uppercase the user
1998    supplied name before doing the comparision, so that everything is
1999    case insensitive.  Same goes for numarg_action. */
2000 
2001                          if arg = "-builtin" then do;       /* skip EXTERNAL_ROUTINE */
2002                               begin;
2003 dcl      next_arg_uppercase     char (next_arg_len);
2004                                    found = "0"b;
2005                                    next_arg_uppercase = translate (next_arg, uppercase, lowercase);
2006                                    do builtin_index = 1 to HIGHEST_BUILTIN_ROUTINE_VALUE while (^found);
2007                                         if builtin_routine_names (builtin_index) = next_arg_uppercase then
2008                                              found = "1"b;
2009                                    end;                     /* do while */
2010                               end;                          /* begin */
2011                               if ^found then do;
2012                                    call io_call_info
2013                                         .
2014                                         error (error_table_$bad_arg, caller,
2015                                         """^a"" is not a builtin editor function. ^a", next_arg, order);
2016                                    call error_exit (Code);
2017                               end;
2018                               line_editor_key_binding_info.action (binding_index) = builtin_index - 1;
2019                                                             /* do loop adds one */
2020                               builtin_given = "1"b;
2021                               external_given = "0"b;
2022                          end;
2023 
2024                          else if arg = "-numarg_action" then do;
2025                               begin;
2026 dcl      next_arg_uppercase     char (next_arg_len);
2027                                    found = "0"b;
2028                                    next_arg_uppercase = translate (next_arg, uppercase, lowercase);
2029                                    do numarg_index = 0 to HIGHEST_NUMARG_ACTION_VALUE while (^found);
2030                                         if numarg_action_names (numarg_index) = next_arg_uppercase then
2031                                              found = "1"b;
2032                                    end;                     /* do while */
2033                               end;                          /* begin */
2034                               if ^found then do;
2035                                    call io_call_info
2036                                         .
2037                                         error (error_table_$bad_arg, caller, """^a"" is not a valid numarg action. ^a",
2038                                         next_arg, order);
2039                                    call error_exit (Code);
2040                               end;
2041                               line_editor_key_binding_info.numarg_action (binding_index) = numarg_index - 1;
2042                                                             /* do loop adds one */
2043                               numarg_action_given = "1"b;
2044                          end;
2045 
2046                          else if arg = "-name" then
2047                               line_editor_key_binding_info.name (binding_index) = next_arg;
2048                          else if arg = "-description" then
2049                               line_editor_key_binding_info.description (binding_index) = next_arg;
2050                          else if arg = "-info_pathname" then do;
2051                               call expand_pathname_$add_suffix ((next_arg), "info",
2052                                    line_editor_key_binding_info.info_dir (binding_index),
2053                                    line_editor_key_binding_info.info_entry (binding_index), code);
2054                               if code ^= 0 then do;
2055                                    call io_call_info.error (code, caller, "The pathname ""^a"". ^a", next_arg, order);
2056                                    call error_exit (Code);
2057                               end;
2058                          end;
2059 
2060                          arg_index = arg_index + 2;         /* make sure we call by reference */
2061 
2062 
2063                     end;                                    /* do while */
2064 
2065                     return;
2066 
2067                end process_control_args;
2068 
2069           end process_key_bindings;
2070 
2071      end process_io_call;
2072 ^L
2073 require_version:
2074      proc (version_found, latest);
2075 
2076 dcl      version_found          fixed bin parameter;
2077 dcl      latest                 fixed bin parameter;
2078 
2079           if version_found ^= latest & version_found ^= editing_chars_version_2 then do;
2080                call error_exit (error_table_$unimplemented_version);
2081           end;
2082 
2083      end require_version;
2084 
2085 require_version_str:
2086      proc (version_found, latest);
2087 
2088 dcl      version_found          char (8) aligned;
2089 dcl      latest                 char (8);
2090 
2091           if version_found ^= latest then do;
2092                call error_exit (error_table_$unimplemented_version);
2093           end;
2094 
2095      end require_version_str;
2096 
2097 check_null:
2098      procedure;
2099           if Info_ptr = null () then do;
2100                call error_exit (error_table_$null_info_ptr);
2101           end;
2102      end check_null;
2103 
2104 require_mbz:
2105      proc (bit_string);
2106 
2107 dcl      bit_string             bit (*);
2108 
2109           if bit_string ^= ""b then do;
2110                call error_exit (error_table_$bad_subr_arg);
2111           end;
2112      end require_mbz;
2113 
2114 setup:
2115      procedure;
2116           attach_data_ptr = Iocb_ptr -> iocb.actual_iocb_ptr -> iocb.attach_data_ptr;
2117           Code = 0;
2118           target_iocbp = attach_data.target_iocb_ptr;
2119      end setup;
2120 
2121 always_breaks:
2122      procedure (c) returns (bit (1) aligned) reducible;
2123 dcl      c                      char (1) aligned parameter;
2124           return (rank (c) <= 31 | c = byte (bin ("177"b3)) /* DEL */);
2125      end always_breaks;
2126 
2127 set_break_table:
2128      proc (c, flag);
2129 
2130 dcl      c                      char (1) aligned;
2131 dcl      flag                   bit (1) unaligned;
2132 
2133           if (rank (c) >= lbound (line_editor_breaks_array, 1)) & (rank (c) <= hbound (line_editor_breaks_array, 1)) then
2134                line_editor_breaks_array (rank (c)) = always_breaks (c) | flag;
2135 
2136      end set_break_table;
2137 
2138 /* Stolen from window_io_iox_ for get_more_responses, get_editing_chars,
2139    and now get_editor_keybindings */
2140 
2141 flat_rep:
2142      procedure (c) returns (char (32) varying) reducible;
2143 
2144 dcl      c                      character (1);
2145 
2146           if c = byte (bin ("015"b3)) then
2147                return ("RETURN");
2148           if c = byte (bin ("033"b3)) then
2149                return ("ESC");
2150           if c < " " then
2151                return ("^" || byte (rank (c) + rank ("@")));
2152           if c = " " then
2153                return ("SPACE");
2154           if c = byte (bin ("177"b3)) then
2155                return ("DEL");
2156           return (c);
2157 
2158      end flat_rep;
2159 
2160 flat_rep_string:
2161      proc (P_string) returns (char (*)) reducible;
2162 
2163 dcl      P_string               char (*) varying;
2164 
2165 dcl      char_idx               fixed bin (21);
2166 
2167           if length (P_string) = 0 then
2168                return ("");                                 /* prevent stringrange below */
2169 
2170           begin;
2171 dcl      flat_string            char (7 * length (P_string)) varying init ("");
2172 
2173                do char_idx = 1 to length (P_string) - 1;
2174                     flat_string = flat_string || flat_rep (substr (P_string, char_idx, 1)) || " ";
2175                end;
2176                flat_string = flat_string || flat_rep (substr (P_string, length (P_string), 1));
2177                return ((flat_string));
2178           end;
2179 
2180      end flat_rep_string;
2181 ^L
2182 /* This is for get_more_handler and for get_editor_key_bindings.
2183    It takes an entry variable and turns it into a segname$entry string,
2184    leaving out the full pathname.  JR 8/7/83 */
2185 
2186 entry_var_to_string:
2187      procedure (routine, entry_string, code);
2188 
2189 dcl      routine                entry;
2190 dcl      entry_string           char (*);
2191 dcl      code                   fixed bin (35);
2192 
2193 dcl      seg_name               char (32);                  /* only the entryname, not the directory */
2194 dcl      entry_point_name       char (32);                  /* entry point within the segment */
2195 
2196 dcl      hcs_$fs_get_path_name  entry (ptr, char (*), fixed bin, char (*), fixed bin (35));
2197 dcl      get_entry_name_        entry (ptr, char (*), fixed bin (18), char (8) aligned, fixed bin (35));
2198 
2199 dcl      1 entry_variable       aligned based,
2200            2 code_ptr           ptr,
2201            2 env_ptr            ptr;
2202 
2203           call hcs_$fs_get_path_name (addr (routine) -> entry_variable.code_ptr, "", (0), seg_name, code);
2204           if code ^= 0 then
2205                return;
2206 
2207           call get_entry_name_ (addr (routine) -> entry_variable.code_ptr, entry_point_name, (0), "", code);
2208           if code ^= 0 then
2209                return;
2210 
2211           entry_string = rtrim (seg_name) || "$" || rtrim (entry_point_name);
2212 
2213           return;
2214 
2215      end entry_var_to_string;
2216 ^L
2217 /* This really doesn't belong here.  It causes this module to have the
2218    knowledge of how to call tc_.  It fit much better in window_io_video_.
2219    It also really doesn't work well from tc_ either, otherwise I would
2220    just pass the order through and deal with it there.  Perhaps the
2221    read_status proc in tc_input should be an entry, and we (or tc_) could
2222    just call it.  But for now ...  -- JR 2/1/84 */
2223 
2224 read_status:
2225      proc ();
2226 
2227 %include tc_operations_;
2228 /* ugh ... this shouldn't be here */
2229 %include tty_read_status_info;
2230 
2231 dcl      1 rqrs                 aligned like request_read_status;
2232                                                             /* let's pretend to be window_/window_io_video_ */
2233 
2234           rqrs.sentinel = REQUEST_SENTINEL;
2235           rqrs.window_id = attach_data.window_id;
2236           rqrs.request_id = clock ();
2237           rqrs.operation = OP_READ_STATUS;
2238           rqrs.row = attach_data.current.line_origin;       /* 1,1 is as good as any ... this prevents out_of_bounds faults way down at tc_ */
2239           rqrs.col = attach_data.current.column_origin;     /* note, these are terminal coords not window coords */
2240           string (rqrs.flags) = ""b;
2241 
2242           call iox_$control (target_iocbp, "window_operation", addr (rqrs), Code);
2243           if Code ^= 0 then
2244                return;                                      /* This should deal with window_status_pending, at least for the reconnection case (or until then the check_in window kludge), but not now. */
2245 
2246           Info_ptr -> tty_read_status_info.event_channel = rqrs.event_channel;
2247           Info_ptr -> tty_read_status_info.input_pending = rqrs.returned_length > 0;
2248 
2249           return;
2250 
2251      end read_status;
2252 
2253 error_exit:
2254      proc (a_code);
2255 
2256 dcl      a_code                 fixed bin (35) parameter;
2257 
2258           Code = a_code;
2259           go to error_return;
2260 
2261      end error_exit;
2262 
2263 error_return:
2264           return;
2265 %page;
2266 copy_new_to_old_special_table:
2267      proc;
2268 
2269 /* special procedure to copy a version 2 special chars structure (15 char
2270    sequences) to a version 1 special chars structure (3 char sequences).
2271    If any of the sequences are too long, it will return non-zero error code */
2272 
2273 dcl      i                      fixed bin;
2274 dcl      old_max_length         fixed bin;
2275 
2276           Code = 0;
2277           old_max_length = hbound (gsi_old.table_ptr -> special_chars_struc_old.nl_seq.chars, 1);
2278 
2279           if attach_data.special_ptr -> special_chars.nl_seq.count > old_max_length then
2280                go to bad_special;
2281           addr (gsi_old.table_ptr -> special_chars_struc_old.nl_seq) -> c_chars_old =
2282                addr (attach_data.special_ptr -> special_chars.nl_seq) -> c_chars_old;
2283           if attach_data.special_ptr -> special_chars.cr_seq.count > old_max_length then
2284                go to bad_special;
2285           addr (gsi_old.table_ptr -> special_chars_struc_old.cr_seq) -> c_chars_old =
2286                addr (attach_data.special_ptr -> special_chars.cr_seq) -> c_chars_old;
2287           if attach_data.special_ptr -> special_chars.bs_seq.count > old_max_length then
2288                go to bad_special;
2289           addr (gsi_old.table_ptr -> special_chars_struc_old.bs_seq) -> c_chars_old =
2290                addr (attach_data.special_ptr -> special_chars.bs_seq) -> c_chars_old;
2291           if attach_data.special_ptr -> special_chars.tab_seq.count > old_max_length then
2292                go to bad_special;
2293           addr (gsi_old.table_ptr -> special_chars_struc_old.tab_seq) -> c_chars_old =
2294                addr (attach_data.special_ptr -> special_chars.tab_seq) -> c_chars_old;
2295           if attach_data.special_ptr -> special_chars.vt_seq.count > old_max_length then
2296                go to bad_special;
2297           addr (gsi_old.table_ptr -> special_chars_struc_old.vt_seq) -> c_chars_old =
2298                addr (attach_data.special_ptr -> special_chars.vt_seq) -> c_chars_old;
2299           if attach_data.special_ptr -> special_chars.ff_seq.count > old_max_length then
2300                go to bad_special;
2301           addr (gsi_old.table_ptr -> special_chars_struc_old.ff_seq) -> c_chars_old =
2302                addr (attach_data.special_ptr -> special_chars.ff_seq) -> c_chars_old;
2303           if attach_data.special_ptr -> special_chars.printer_on.count > old_max_length then
2304                go to bad_special;
2305           addr (gsi_old.table_ptr -> special_chars_struc_old.printer_on) -> c_chars_old =
2306                addr (attach_data.special_ptr -> special_chars.printer_on) -> c_chars_old;
2307           if attach_data.special_ptr -> special_chars.printer_off.count > old_max_length then
2308                go to bad_special;
2309           addr (gsi_old.table_ptr -> special_chars_struc_old.printer_off) -> c_chars_old =
2310                addr (attach_data.special_ptr -> special_chars.printer_off) -> c_chars_old;
2311           if attach_data.special_ptr -> special_chars.red_ribbon_shift.count > old_max_length then
2312                go to bad_special;
2313           addr (gsi_old.table_ptr -> special_chars_struc_old.red_ribbon_shift) -> c_chars_old =
2314                addr (attach_data.special_ptr -> special_chars.red_ribbon_shift) -> c_chars_old;
2315           if attach_data.special_ptr -> special_chars.black_ribbon_shift.count > old_max_length then
2316                go to bad_special;
2317           addr (gsi_old.table_ptr -> special_chars_struc_old.black_ribbon_shift) -> c_chars_old =
2318                addr (attach_data.special_ptr -> special_chars.black_ribbon_shift) -> c_chars_old;
2319           if attach_data.special_ptr -> special_chars.end_of_page.count > old_max_length then
2320                go to bad_special;
2321           addr (gsi_old.table_ptr -> special_chars_struc_old.end_of_page) -> c_chars_old =
2322                addr (attach_data.special_ptr -> special_chars.end_of_page) -> c_chars_old;
2323           gsi_old.table_ptr -> special_chars_struc_old.escape_length =
2324                attach_data.special_ptr -> special_chars.escape_length;
2325           do i = 1 to attach_data.special_ptr -> special_chars.escape_length;
2326                if attach_data.special_ptr -> special_chars.not_edited_escapes (i).count > old_max_length then
2327                     go to bad_special;
2328                addr (gsi_old.table_ptr -> special_chars_struc_old.not_edited_escapes (i)) -> c_chars_old =
2329                     addr (attach_data.special_ptr -> special_chars.not_edited_escapes (i)) -> c_chars_old;
2330                if attach_data.special_ptr -> special_chars.edited_escapes (i).count > old_max_length then
2331                     go to bad_special;
2332                addr (gsi_old.table_ptr -> special_chars_struc_old.edited_escapes (i)) -> c_chars_old =
2333                     addr (attach_data.special_ptr -> special_chars.edited_escapes (i)) -> c_chars_old;
2334           end;
2335           gsi_old.table_ptr -> special_chars_struc_old.input_escapes =
2336                attach_data.special_ptr -> special_chars.input_escapes;
2337           gsi_old.table_ptr -> special_chars_struc_old.input_results =
2338                attach_data.special_ptr -> special_chars.input_results;
2339 
2340           return;
2341 
2342 bad_special:
2343           Code = error_table_$invalid_array_size;
2344           return;
2345 
2346      end copy_new_to_old_special_table;
2347 %page;
2348 copy_old_to_new_special_table:
2349      proc;
2350 
2351 /* special procedure to copy a version 1 special chars structure (3 char
2352    sequences) to a version 2 special chars structure (15 char sequences). */
2353 
2354 dcl      i                      fixed bin;
2355 
2356           addr (temp_ptr -> special_chars.nl_seq) -> c_chars_old =
2357                addr (addr (scs.special_chars) -> special_chars_old.nl_seq) -> c_chars_old;
2358           addr (temp_ptr -> special_chars.cr_seq) -> c_chars_old =
2359                addr (addr (scs.special_chars) -> special_chars_old.cr_seq) -> c_chars_old;
2360           addr (temp_ptr -> special_chars.bs_seq) -> c_chars_old =
2361                addr (addr (scs.special_chars) -> special_chars_old.bs_seq) -> c_chars_old;
2362           addr (temp_ptr -> special_chars.tab_seq) -> c_chars_old =
2363                addr (addr (scs.special_chars) -> special_chars_old.tab_seq) -> c_chars_old;
2364           addr (temp_ptr -> special_chars.vt_seq) -> c_chars_old =
2365                addr (addr (scs.special_chars) -> special_chars_old.vt_seq) -> c_chars_old;
2366           addr (temp_ptr -> special_chars.ff_seq) -> c_chars_old =
2367                addr (addr (scs.special_chars) -> special_chars_old.ff_seq) -> c_chars_old;
2368           addr (temp_ptr -> special_chars.printer_on) -> c_chars_old =
2369                addr (addr (scs.special_chars) -> special_chars_old.printer_on) -> c_chars_old;
2370           addr (temp_ptr -> special_chars.printer_off) -> c_chars_old =
2371                addr (addr (scs.special_chars) -> special_chars_old.printer_off) -> c_chars_old;
2372           addr (temp_ptr -> special_chars.red_ribbon_shift) -> c_chars_old =
2373                addr (addr (scs.special_chars) -> special_chars_old.red_ribbon_shift) -> c_chars_old;
2374           addr (temp_ptr -> special_chars.black_ribbon_shift) -> c_chars_old =
2375                addr (addr (scs.special_chars) -> special_chars_old.black_ribbon_shift) -> c_chars_old;
2376           addr (temp_ptr -> special_chars.end_of_page) -> c_chars_old =
2377                addr (addr (scs.special_chars) -> special_chars_old.end_of_page) -> c_chars_old;
2378           temp_ptr -> special_chars.escape_length = addr (scs.special_chars) -> special_chars_old.escape_length;
2379           do i = 1 to attach_data.special_ptr -> special_chars.escape_length;
2380                addr (temp_ptr -> special_chars.not_edited_escapes (i)) -> c_chars_old =
2381                     addr (addr (scs.special_chars) -> special_chars_old.not_edited_escapes (i)) -> c_chars_old;
2382                addr (temp_ptr -> special_chars.edited_escapes (i)) -> c_chars_old =
2383                     addr (addr (scs.special_chars) -> special_chars_old.edited_escapes (i)) -> c_chars_old;
2384           end;
2385           temp_ptr -> special_chars.input_escapes = addr (scs.special_chars) -> special_chars_struc_old.input_escapes;
2386           temp_ptr -> special_chars.input_results = addr (scs.special_chars) -> special_chars_struc_old.input_results;
2387 
2388           return;
2389 
2390      end copy_old_to_new_special_table;
2391 %page;
2392 %include window_io_attach_data_;
2393 %include window_control_info;
2394 %page;
2395 %include iocb;
2396 %page;
2397 %include tc_desk_info_;
2398 %page;
2399 %include tty_editing_chars;
2400 %page;
2401 %include tty_convert;
2402 %page;
2403 %include iox_dcls;
2404 %page;
2405 %include mode_string_info;
2406 %page;
2407 %include window_dcls;
2408 %page;
2409 %include terminal_type_data;
2410 %page;
2411 %include terminal_info;
2412 
2413      end wioctl_;
2414