1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) Honeywell Bull Inc., 1987                *
   4         *                                                         *
   5         * Copyright (c) 1986 by Massachusetts Institute of        *
   6         * Technology and Honeywell Information Systems, Inc.      *
   7         *                                                         *
   8         * Copyright, (C) Honeywell Information Systems Inc., 1981 *
   9         *                                                         *
  10         * Copyright (c) 1972 by Massachusetts Institute of        *
  11         * Technology and Honeywell Information Systems, Inc.      *
  12         *                                                         *
  13         *********************************************************** */
  14 
  15 
  16 
  17 /****^  HISTORY COMMENTS:
  18   1) change(81-01-01,Margulies), approve(), audit(), install():
  19      These are the journalization comments from window_io_video_, which is
  20      now incorporated in this module.
  21 
  22      video operations for window_io_
  23 
  24      asyncronous event management in this program is different
  25      from that in terminal control. In terminal control, the program can
  26      detect something happening during a block, and then give up on what it was
  27      going to write and recompute based on the state after the async occurence.
  28      Here, terminal controlwill do what we call it to do,
  29      unless a nonlocal goto is used to unwind the terminal control operation.
  30      This is a trifle dangerous, as the calls to terminal control are
  31      nonatomic ... they may consist of several distinct terminal operations.
  32 
  33      NB: OP_WRITE_SYNC_GET_CHARS_NO_ECHO is obsolete. In the current
  34      terminal control implementation, it is equivalent to a WRITE, followed
  35      by a SYNC, followed by a GET. The window operation, and for that matter
  36      the tc operation, may become meaningful again in a later implementation,
  37      and there was not time to gut the callers.
  38 
  39      Modified 21 January 1982 by Chris Jones to re-enable quits after
  40      reconnection
  41 
  42      Modified 16 August 1982 by William M. York to fix W_GET_ECHOED_CHARS so
  43      it doesn't try to update the cursor position after an async event occurs
  44      in the current window.  Since the cursor has moved somewhere else, this
  45      caused the cursor state to become invalid.
  46 
  47      Modified 16 September 1982 by WMY to fix W_GET_ECHOED_CHARS to handle the
  48      case where tc_ returned because of async interruption and the input buffer
  49      happened to be full.  This bug caused looping and process death.
  50 
  51      Modified 21 September 1982 by WMY fix a bug in W_SYNC which passed the
  52      wrong structure down to tc_.
  53 
  54      Modified 29 October 1982 by WMY to update the attach_data.col after a
  55      successful OP_WRITE_SYNC_GET_CHARS_NO_ECHO to include the prompt.
  56   2) change(81-01-01,WMY), approve(), audit(), install():
  57      Set status on raw output calls, but ignore that status when the next raw
  58      output call comes in.
  59 
  60      Modified 1 October 1983 by Jon A. Rochlis to add support for partial
  61      screen width windows.
  62 
  63      Modified 30 September 1983 by Jon A. Rochlis to add support for partial
  64      screen width windows to create_window.
  65 
  66      Modified 9 October 1983 by JR to map error_table_$undefined_order_request
  67      into video_et_$wsys_not_invoked.
  68 
  69      Modified 9 October 1983 by Jon A. Rochlis to add first cut
  70      at window_$edit_line.
  71 
  72      Modifed December 1983 - February 1984 by Bill Gimbel and JR to move
  73      window_io_video_ to this module.
  74 
  75      Modified 27 December 1984 by JR to only update attach_data state if calls
  76      to tc_ were successful.  This prevent inconsistent states which could
  77      hang a process.
  78 
  79      Modified 7 February 1985 by JR to store the current ips mask in tc's
  80      request structure so tc_block can restore it before going blocked.
  81 
  82      user interface to extended video operations
  83   3) change(87-02-13,LJAdams), approve(87-03-19,MCR7642),
  84      audit(87-04-24,Gilcrease), install(87-05-14,MR12.1-1030):
  85      The entry points insert_text and overwrite_text are calling
  86      require_cursor_valid after masking IPS signals.  If the cursor position is
  87      invalid because the write_raw_text entry was previously called, the
  88      require_cursor_valid procedure will exit window_ leaving the signals
  89      masked.  (phx20711).
  90                                                    END HISTORY COMMENTS */
  91 
  92 ^L
  93 
  94 /* format: style2,linecom,^indnoniterdo,indcomtxt,^inditerdo,dclind5,idind25 */
  95 window_:
  96      procedure;
  97           return;
  98 
  99           declare 1 simple_r               aligned like request_header;
 100 
 101           declare real_window_iocb_ptr     pointer;
 102           declare target_iocbp             pointer;
 103           declare this_request_ptr         pointer;
 104           declare this_is_an_input_request bit (1) aligned;
 105           declare saved_ips_mask           bit (36) aligned;
 106           declare cleanup                  condition;
 107 
 108           declare (
 109                   hcs_$set_ips_mask,
 110                   hcs_$reset_ips_mask
 111                   )                        entry (bit (36) aligned, bit (36) aligned);
 112 
 113 
 114           declare (
 115                   video_et_$window_status_pending,
 116                   video_et_$bad_window_id,
 117                   video_et_$cursor_position_undefined,
 118                   video_et_$string_not_printable
 119                   )                        external static fixed bin (35);
 120 
 121           declare (
 122                   Iocb_ptr                 pointer,
 123                   Distance                 fixed bin,
 124                   Line                     fixed bin,
 125                   Col                      fixed bin,
 126                   N_lines                  fixed bin,
 127                   N_cols                   fixed bin,
 128                   Count                    fixed bin,
 129                   N_to_get                 fixed bin (21),
 130                   Text                     character (*),
 131                   Prompt                   character (*),
 132                   Text_got                 fixed bin (21),
 133                   Break                    character (1) varying,
 134                   Code                     fixed bin (35)
 135                   )                        parameter;
 136 
 137           declare (addcharno, addr, character, clock, currentsize, length, ltrim, max, null, rtrim, string, substr,
 138                   unspec, verify)          builtin;
 139 ^L
 140 position_cursor:
 141      entry (Iocb_ptr, Line, Col, Code);
 142           dcl  (line, col)              fixed bin;
 143           call get_attach_data_ptr;
 144 
 145           line = Line;
 146           col = Col;
 147 pc_common:
 148           on cleanup call clean_things_up ();
 149           call setup_request (addr (simple_r), OP_POSITION_CURSOR, line, col);
 150           call do_request (addr (simple_r));
 151 
 152           if Code = 0
 153           then do;                                          /* only update state, if the operation worked */
 154                attach_data.line = line;
 155                attach_data.col = col;
 156                attach_data.cursor_valid = "1"b;
 157           end;
 158           go to done;
 159 
 160 position_cursor_rel:
 161      entry (Iocb_ptr, Line, Col, Code);
 162 
 163           call get_attach_data_ptr;
 164           call require_cursor_valid;
 165 
 166           line = Line + attach_data.line;
 167           col = Col + attach_data.col;
 168           goto pc_common;
 169 
 170 change_column:
 171      entry (Iocb_ptr, Col, Code);
 172           call get_attach_data_ptr;
 173           call require_cursor_valid;
 174           line = attach_data.line;
 175           col = Col;
 176           go to pc_common;
 177 
 178 change_line:
 179      entry (Iocb_ptr, Line, Code);
 180           call get_attach_data_ptr;
 181           call require_cursor_valid;
 182           col = attach_data.col;
 183           line = Line;
 184           go to pc_common;
 185 ^L
 186           declare 1 rqr                    aligned like request_clear_region;
 187 
 188 clear_window:
 189      entry (Iocb_ptr, Code);
 190 
 191 clear_window_label:
 192           call get_attach_data_ptr;
 193           on cleanup call clean_things_up ();
 194           call setup_request (addr (rqr), OP_CLEAR_REGION, 1, 1);
 195 
 196           rqr.rows = attach_data.current.rows;
 197           rqr.columns = attach_data.current.columns;
 198 
 199           call do_request (addr (rqr));
 200           if Code = 0
 201           then do;
 202                attach_data.line, attach_data.col = 1;
 203                attach_data.cursor_valid = "1"b;
 204 
 205 /* This is an awful modularity violation since this variable should
 206    only be touched by window_io_iox_. However, until there are more
 207    control orders for window operations, we are stuck with it. */
 208                attach_data.lines_written_since_read = 0;
 209           end;
 210           go to done;
 211 
 212 clear_to_end_of_window:
 213      entry (Iocb_ptr, Code);
 214 
 215           call get_attach_data_ptr;
 216           call require_cursor_valid;
 217           if attach_data.col = 1                            /* Are we at */
 218                & attach_data.line = 1                       /* The Origin? */
 219           then go to clear_window_label;                    /* Much Easier */
 220 
 221           on cleanup call clean_things_up ();
 222           call setup_request (addr (rqr), OP_CLEAR_REGION, attach_data.line, attach_data.col);
 223                                                             /* first approx */
 224 
 225           if attach_data.col > 1
 226           then do;
 227                rqr.rows = 1;
 228                rqr.columns = attach_data.current.columns - attach_data.col + 1;
 229                call do_request (addr (rqr));                /* clear off current line */
 230                if rqr.row < attach_data.current.rows
 231                then do;                                     /* now do full-width part */
 232                     rqr.columns = attach_data.current.columns;
 233                     rqr.row = rqr.row + 1;
 234                     rqr.rows = attach_data.current.rows - attach_data.line;
 235                                                             /* + 1 canceled by the row we already got */
 236                     rqr.col = 1;
 237                     if rqr.rows > 1
 238                     then call do_request (addr (rqr));
 239                end;
 240           end;
 241           else do;                                          /* start at col 1 */
 242 
 243                rqr.columns = attach_data.current.columns;
 244                rqr.rows = attach_data.current.rows - attach_data.line + 1;
 245                if rqr.rows ^< 1
 246                then call do_request (addr (rqr));
 247           end;
 248 
 249           if attach_data.col > 1                            /* we had to clear end of line */
 250           then do;
 251                call clean_things_up ();
 252                call setup_request (addr (simple_r), OP_POSITION_CURSOR, attach_data.line, attach_data.col);
 253                call do_request (addr (simple_r));
 254           end;                                              /* do */
 255           go to done;
 256 
 257 clear_to_end_of_line:
 258      entry (Iocb_ptr, Code);
 259           call get_attach_data_ptr;
 260           call require_cursor_valid;
 261           on cleanup call clean_things_up ();
 262           call setup_request (addr (rqr), OP_CLEAR_REGION, attach_data.line, attach_data.col);
 263           rqr.rows = 1;
 264           rqr.columns = attach_data.current.columns - attach_data.col + 1;
 265           call do_request (addr (rqr));
 266           go to done;
 267 
 268 clear_region:
 269      entry (Iocb_ptr, Line, Col, N_lines, N_cols, Code);
 270           call get_attach_data_ptr;
 271           on cleanup call clean_things_up ();
 272           call setup_request (addr (rqr), OP_CLEAR_REGION, Line, Col);
 273           rqr.extent.rows = N_lines;
 274           rqr.extent.columns = N_cols;
 275 
 276           call do_request (addr (rqr));
 277 
 278           if Code = 0
 279           then do;
 280                attach_data.col = Col;
 281                attach_data.line = Line;
 282                attach_data.cursor_valid = "1"b;
 283           end;
 284           go to done;
 285 ^L
 286           declare 1 rqt                    aligned like request_text;
 287 
 288 insert_text:
 289      entry (Iocb_ptr, Text, Code);
 290 
 291           call get_attach_data_ptr;
 292           call require_cursor_valid;
 293           on cleanup call clean_things_up ();
 294           call setup_request (addr (rqt), OP_INSERT_TEXT, attach_data.line, attach_data.col);
 295           go to tx_common;
 296 
 297 overwrite_text:
 298      entry (Iocb_ptr, Text, Code);
 299 
 300           call get_attach_data_ptr;
 301           call require_cursor_valid;
 302           on cleanup call clean_things_up ();
 303           call setup_request (addr (rqt), OP_OVERWRITE_TEXT, attach_data.line, attach_data.col);
 304 
 305 tx_common:
 306           call validate_text (Text);
 307           rqt.text_ptr = addr (Text);
 308           rqt.text_length = length (Text);
 309           call do_request (addr (rqt));
 310           if Code = 0
 311           then attach_data.col = attach_data.col + rqt.text_length;
 312           go to done;
 313 
 314 write_raw_text:
 315      entry (Iocb_ptr, Text, Code);
 316           call get_attach_data_ptr;
 317           if attach_data.status_pending & ^attach_data.ignore_status
 318           then if unspec (attach_data.status) ^= unspec (W_STATUS_SCREEN_INVALID)
 319                then do;
 320                     Code = video_et_$window_status_pending;
 321                     goto error_return;
 322                end;
 323 
 324           on cleanup call clean_things_up ();
 325           call setup_request (addr (rqt), OP_WRITE_RAW, attach_data.line, attach_data.col);
 326           if ^attach_data.cursor_valid
 327           then do;
 328                rqt.row = attach_data.line_origin;           /* as good a place as any */
 329                rqt.col = 1;
 330           end;
 331           rqt.text_ptr = addr (Text);
 332           rqt.text_length = length (Text);
 333           call do_request (addr (rqt));
 334 
 335           if Code = 0
 336           then do;
 337                attach_data.cursor_valid = "0"b;
 338                attach_data.status.screen_invalid = "1"b;
 339                attach_data.status_pending = "1"b;
 340           end;
 341           go to done;
 342 
 343 delete_chars:
 344      entry (Iocb_ptr, Count, Code);
 345           call get_attach_data_ptr;
 346           declare 1 rqd                    aligned like request_delete_chars;
 347           call require_cursor_valid;
 348           on cleanup call clean_things_up ();
 349           call setup_request (addr (rqd), OP_DELETE_CHARS, attach_data.line, attach_data.col);
 350           rqd.count = Count;
 351           call do_request (addr (rqd));
 352           go to done;
 353 
 354 get_cursor_position:
 355      entry (Iocb_ptr, Line, Col, Code);
 356           call get_attach_data_ptr;
 357           call require_cursor_valid;
 358           Line = attach_data.line;
 359           Col = attach_data.col;
 360           return;
 361 
 362 bell:
 363      entry (Iocb_ptr, Code);
 364           call get_attach_data_ptr;
 365           call require_cursor_valid;
 366           on cleanup call clean_things_up ();
 367           call setup_request (addr (simple_r), OP_BELL, attach_data.line, attach_data.col);
 368           call do_request (addr (simple_r));
 369           go to done;
 370 ^L
 371           declare 1 rqg                    aligned like request_read;
 372           declare rqg_text                 character (rqg.buffer_length) based (rqg.buffer_ptr);
 373 
 374 get_unechoed_chars:
 375      entry (Iocb_ptr, N_to_get, Text, Text_got, Break, Code);
 376           call get_attach_data_ptr;
 377           on cleanup call clean_things_up ();
 378           call setup_request (addr (rqg), OP_GET_CHARS_NO_ECHO, attach_data.line, attach_data.col);
 379                                                             /* we don't check the cursor position for unechoed input */
 380           rqg.prompt_ptr = null ();
 381           go to get_common;
 382 
 383 get_echoed_chars:
 384      entry (Iocb_ptr, N_to_get, Text, Text_got, Break, Code);
 385           call get_attach_data_ptr;
 386           call require_cursor_valid;
 387           on cleanup call clean_things_up ();
 388           call setup_request (addr (rqg), OP_GET_CHARS_ECHO, attach_data.line, attach_data.col);
 389           rqg.prompt_ptr = null ();
 390 
 391 get_common:
 392           Break = "";
 393           rqg.buffer_ptr = addr (Text);
 394           rqg.buffer_length = N_to_get;
 395           rqg.breaks = attach_data.breaks;
 396 
 397           Text_got = 0;
 398 
 399 get_some_more:
 400           rqg.returned_break_flag = "0"b;
 401           rqg.returned_length = 0;
 402           rqg.col = attach_data.col + attach_data.column_origin - 1;
 403 
 404           call do_request (addr (rqg));
 405 
 406           Text_got = Text_got + rqg.returned_length;
 407 
 408 /* This gets complicated.  If something asynchronous has happened
 409    in this window, we don't really know where the cursor is,
 410    and we certainly shouldn't set the cursor position to our now
 411    invalid idea of where it is.  If it happened in some other
 412    window, update the cursor state and get some more chars. */
 413 
 414           if rqg.async_interruption                         /* ASSERT cannot be on if returned_break_flag is on */
 415           then do;                                          /* something went BONG */
 416                if rqg.this_window
 417                then do;
 418                     attach_data.status.async_change = "1"b;
 419                     attach_data.status_pending = "1"b;
 420 
 421 /* If we got something, return it and q status for next call.
 422    if we got nothing, might as well return the status this call.
 423    but never return status AND characters. */
 424 
 425                     if Text_got = 0
 426                     then Code = video_et_$window_status_pending;
 427                     go to done;
 428                end;
 429                else do;                                     /* Some Other Window */
 430 
 431                     rqg.buffer_ptr = addcharno (rqg.buffer_ptr, rqg.returned_length);
 432                     rqg.buffer_length = rqg.buffer_length - rqg.returned_length;
 433 
 434 /* update the cursor state so far */
 435                     if rqg.operation = OP_GET_CHARS_ECHO
 436                     then attach_data.col = attach_data.col + rqg.returned_length;
 437 
 438                     if rqg.operation = OP_WRITE_SYNC_GET_CHARS_NO_ECHO
 439                     then do;                                /* don't reprint prompt, just read response */
 440                          rqg.operation = OP_GET_CHARS_NO_ECHO;
 441                          attach_data.col = rqg.col + rqg.prompt_length;
 442                     end;
 443 
 444 /* At this point we know that tc_ level returned
 445    because something asynchronous happened in another
 446    window.  If the user was in the phantom column at the
 447    time, the call to tc_ returned enough characters to
 448    fill our caller's buffer, so return.  */
 449 
 450                     if rqg.returned_length = rqg.buffer_length
 451                     then goto done;
 452                     else goto get_some_more;
 453 
 454                end;
 455           end;                                              /* The async term case */
 456 
 457 /* no async, so update the cursor position */
 458           if rqg.operation = OP_GET_CHARS_ECHO
 459           then do;
 460                attach_data.col = attach_data.col + rqg.returned_length;
 461                if rqg.returned_break_flag & (rqg.returned_length > 0)
 462                then attach_data.col = attach_data.col - 1;  /* The last one isn't really there */
 463           end;
 464           else if rqg.operation = OP_WRITE_SYNC_GET_CHARS_NO_ECHO
 465           then attach_data.col = rqg.col + rqg.prompt_length;
 466 
 467           if rqg.returned_break_flag & rqg.returned_length > 0
 468           then do;
 469                Text_got = Text_got - 1;
 470                Break = substr (rqg_text, rqg.returned_length, 1);
 471           end;
 472           go to done;
 473 
 474 get_one_unechoed_char:
 475 get_one_unechoed:
 476      entry (Iocb_ptr, One, Block_flag, Code);
 477 
 478           declare One                      character (1) varying;
 479           declare one_char                 character (1);
 480           declare Block_flag               bit (1) aligned;
 481 
 482           call get_attach_data_ptr;
 483           call require_cursor_valid;
 484           on cleanup call clean_things_up ();
 485           call setup_request (addr (rqg), OP_READ_ONE, attach_data.line, attach_data.col);
 486 
 487           rqg.buffer_ptr = addr (one_char);
 488           rqg.buffer_length = 1;
 489 
 490 one_some_more:                                              /* returned_break_flag is the block flag on input, and the
 491                                                                break_flag on output */
 492           rqg.returned_break_flag = Block_flag;
 493           call do_request (addr (rqg));
 494 
 495 /* Several things could have happened in the call to tc_.
 496    1) called in with block flag off, no asyncronosity possible cause we
 497    didn't block regardless of what we got back.
 498    2) called in with block flag, nothing async happens while blocked, got char.
 499    3) called in with block flag, async event happend, no char back. */
 500 
 501           if rqg.async_interruption
 502           then if rqg.this_window
 503                then do;
 504                     attach_data.status.async_change = "1"b;
 505                     attach_data.status_pending = "1"b;
 506                     Code = video_et_$window_status_pending;
 507                     go to done;
 508                end;
 509                else goto one_some_more;
 510 
 511           if ^Block_flag & ^rqg.returned_break_flag
 512           then One = "";
 513           else One = one_char;
 514 
 515           go to done;
 516 
 517 write_sync_read:
 518      entry (Iocb_ptr, Prompt, N_to_get, Text, Text_got, Break, Code);
 519           call get_attach_data_ptr;
 520           call require_cursor_valid;
 521           on cleanup call clean_things_up ();
 522           call setup_request (addr (rqg), OP_WRITE_SYNC_GET_CHARS_NO_ECHO, attach_data.line, attach_data.col);
 523 
 524           rqg.prompt_ptr = addr (Prompt);
 525           rqg.prompt_length = length (Prompt);
 526 
 527           goto get_common;
 528 
 529 sync:
 530      entry (Iocb_ptr, Code);
 531           call get_attach_data_ptr;
 532           on cleanup call clean_things_up ();
 533           call setup_request (addr (rqg), OP_GET_CHARS_NO_ECHO, attach_data.line, attach_data.col);
 534           rqg.buffer_length = 0;
 535           call do_request (addr (rqg));                     /* lengths are 0 */
 536           go to done;
 537 ^L
 538 /* This is somewhat of a kludge, but is a first cut at allowing the
 539    video system line editor to be called from a window_ context, rather than
 540    an iox_ context.  It is very un-window_ like, since we don't make a control
 541    order for tc_io_, but instead call window_io_iox_ directly.  When
 542    the editor moves out of window_io_iox_ and window_io_ is taught about
 543    this then it can be changed. All we are at the moment is a blown up
 544    transfer vector! */
 545 
 546 edit_line:
 547      entry (Iocb_ptr, Window_edit_line_info_ptr, Buffer_ptr, Buffer_len, N_read, Code);
 548 
 549           declare Window_edit_line_info_ptr
 550                                            pointer parameter;
 551           declare Buffer_ptr               pointer parameter;
 552           declare Buffer_len               fixed binary (21) parameter;
 553           declare N_read                   fixed binary (21) parameter;
 554 
 555           declare window_io_iox_$edit_line entry (ptr, ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));
 556 
 557           call get_attach_data_ptr;
 558           call require_cursor_valid;
 559           call window_io_iox_$edit_line (real_window_iocb_ptr /* set by get_attach_data_ptr */, Window_edit_line_info_ptr,
 560                Buffer_ptr, Buffer_len, N_read, Code);
 561           return;
 562 ^L
 563 scroll_region:
 564      entry (Iocb_ptr, Line, N_lines, Distance, Code);
 565 
 566           declare 1 rsr                    aligned like request_scroll_region;
 567           call get_attach_data_ptr;
 568           call require_cursor_valid;
 569           on cleanup call clean_things_up ();
 570           call setup_request (addr (rsr), OP_SCROLL_REGION, 1, 1);
 571                                                             /* The coords are not interesting */
 572 
 573           rsr.n_lines = N_lines;
 574           rsr.distance = Distance;
 575           rsr.start_line = Line + attach_data.line_origin - 1;
 576           call do_request (addr (rsr));
 577           go to done;
 578 ^L
 579 /* Create and Destroy utilities -- the beginnings of the window
 580    side of desk management. */
 581 
 582           declare window_list_ptr          pointer;
 583           declare 1 window_list            aligned based (window_list_ptr),
 584                     2 sentinel             character (4) aligned,
 585                     2 n_windows            fixed bin,
 586                     2 window_names         (wl_n_windows refer (window_list.n_windows)) character (32) unaligned;
 587 
 588           declare wl_n_windows             fixed bin;
 589           declare (i, j)                   fixed bin;
 590           declare code                     fixed bin (35);
 591           declare value_$get_data          entry (pointer, bit (36) aligned, character (*), pointer, pointer,
 592                                            fixed binary (18), fixed binary (35));
 593           declare value_$set_data          entry (pointer, bit (36) aligned, character (*), pointer, fixed binary (18),
 594                                            pointer, pointer, fixed binary (18), fixed binary (35));
 595           declare (
 596                   error_table_$null_info_ptr,
 597                   error_table_$unimplemented_version
 598                   )                        fixed bin (35) ext static;
 599           declare video_et_$switch_not_window
 600                                            fixed bin (35) external static;
 601 get_window_list:
 602      procedure (terminal_name);
 603           declare terminal_name            character (*);
 604           declare value_name               character (45) /* 32 + 13 */;
 605           declare no_create                bit (1) aligned;
 606 
 607           declare WINDOW_LIST_VALUE_NAME_SUFFIX
 608                                            character (12) init ("window_list_") internal static options (constant);
 609 
 610           no_create = "0"b;
 611           go to common;
 612 
 613 get_window_list$$no_create:
 614      entry (terminal_name);
 615           no_create = "1"b;
 616 
 617 common:
 618           window_list_ptr = null ();
 619           value_name = rtrim (terminal_name) || WINDOW_LIST_VALUE_NAME_SUFFIX;
 620 
 621           call value_$get_data (null (), "10"b /* perprocess */, value_name, get_system_free_area_ (), window_list_ptr,
 622                (0), code);
 623 
 624           if window_list_ptr = null ()
 625           then do;
 626                if no_create
 627                then return;
 628                wl_n_windows = 1;
 629                allocate window_list set (window_list_ptr);
 630                window_list.sentinel = "WNDL";
 631                window_list.n_windows = 0;                   /* careful here, to avoid pl1 illegalities */
 632           end;
 633           return;
 634 
 635 store_window_list:
 636      entry (terminal_name);
 637           declare size_of_window_list      fixed bin (18);
 638 
 639           value_name = rtrim (terminal_name) || WINDOW_LIST_VALUE_NAME_SUFFIX;
 640 
 641           if window_list_ptr ^= null ()
 642           then size_of_window_list = currentsize (window_list);
 643           else size_of_window_list = 0;
 644           call value_$set_data (null (), "10"b /* perprocess */, value_name, window_list_ptr, size_of_window_list,
 645                null (), null (), (0), (0));                 /* we ignore the code */
 646           if window_list_ptr ^= null ()
 647           then free window_list;
 648           return;
 649      end;
 650 ^L
 651 
 652 create:
 653 create_window:
 654      entry (Terminal_iocb_ptr, Window_info_ptr, Window_iocb_ptr, Code);
 655           declare Terminal_iocb_ptr        pointer parameter;
 656           declare terminal_iocb_ptr        pointer;
 657           declare Window_iocb_ptr          pointer parameter;
 658           declare Window_info_ptr          pointer parameter;
 659 
 660           terminal_iocb_ptr = Terminal_iocb_ptr;
 661           window_position_info_ptr = Window_info_ptr;
 662           Code = 0;
 663           if window_position_info_ptr = null () | Window_iocb_ptr = null () | Terminal_iocb_ptr = null ()
 664           then do;
 665                Code = error_table_$null_info_ptr;
 666                return;
 667           end;
 668 
 669           if window_position_info.version ^= window_position_info_version
 670           then do;
 671                Code = error_table_$unimplemented_version;
 672                return;
 673           end;
 674 
 675           begin;
 676                declare atd                      character (128);
 677 
 678                atd = "window_io_ " || iocb_name (terminal_iocb_ptr) || " -first_line "
 679                     || ltrim (rtrim (character (window_position_info.origin.line)));
 680 
 681                if window_position_info.height > 0
 682                then atd = rtrim (atd) || " -n_lines " || ltrim (rtrim (character (window_position_info.height)));
 683 
 684                if window_position_info.origin.column > 0
 685                then atd = rtrim (atd) || " -first_column "
 686                          || ltrim (rtrim (character (window_position_info.origin.column)));
 687 
 688                if window_position_info.width > 0
 689                then atd = rtrim (atd) || " -n_columns " || ltrim (rtrim (character (window_position_info.width)));
 690 
 691                call iox_$attach_ptr (Window_iocb_ptr, atd, null (), Code);
 692                if Code ^= 0
 693                then return;
 694           end;
 695 
 696           call iox_$open (Window_iocb_ptr, Stream_input_output, ""b, Code);
 697           if Code ^= 0
 698           then do;
 699                call iox_$detach_iocb (Window_iocb_ptr, (0));
 700                return;
 701           end;
 702 
 703           call get_window_list$$no_create (iocb_name (terminal_iocb_ptr));
 704           begin;
 705                declare new_window_list_ptr      pointer;
 706 
 707                if window_list_ptr = null ()
 708                then wl_n_windows = 1;
 709                else wl_n_windows = window_list.n_windows + 1;
 710                allocate window_list set (new_window_list_ptr);
 711                new_window_list_ptr -> window_list.sentinel = "WNDL";
 712                if window_list_ptr ^= null ()
 713                then do;
 714                     do i = 1 to window_list.n_windows;
 715                          new_window_list_ptr -> window_list.window_names (i) = window_list.window_names (i);
 716                     end;
 717                     free window_list;
 718                end;
 719                else i = 1;
 720                window_list_ptr = new_window_list_ptr;
 721                window_list.window_names (i) = iocb_name (Window_iocb_ptr);
 722           end;                                              /* the begin block */
 723           call store_window_list (iocb_name (terminal_iocb_ptr));
 724 
 725           return;
 726 
 727 destroy:
 728 destroy_window:
 729      entry (Window_iocb_ptr, Code);
 730 
 731           call iox_$control (Window_iocb_ptr, "get_terminal_iocb_ptr", terminal_iocb_ptr, Code);
 732           if Code ^= 0
 733           then return;
 734 
 735           call get_window_list (iocb_name (terminal_iocb_ptr));
 736 
 737           do i = 1 to window_list.n_windows;
 738                if window_list.window_names (i) = iocb_name (Window_iocb_ptr)
 739                then do;
 740                     if i < window_list.n_windows
 741                     then do j = i + 1 to window_list.n_windows;
 742                          window_list.window_names (j - 1) = window_list.window_names (j);
 743                     end;
 744                     go to SUCCESS;
 745                end;
 746           end;
 747           Code = video_et_$switch_not_window;
 748           return;
 749 
 750 SUCCESS:
 751           call iox_$close (Window_iocb_ptr, (0));
 752           call iox_$detach_iocb (Window_iocb_ptr, (0));
 753 
 754           begin;
 755                declare new_window_list_ptr      pointer;
 756                wl_n_windows = window_list.n_windows - 1;
 757                if wl_n_windows = 0
 758                then free window_list;
 759                else do;
 760                     allocate window_list set (new_window_list_ptr);
 761                     do i = 1 to wl_n_windows;
 762                          new_window_list_ptr -> window_list.window_names (i) = window_list.window_names (i);
 763                     end;
 764                     free window_list;
 765                     window_list_ptr = new_window_list_ptr;
 766                end;
 767           end;                                              /* the begin */
 768 
 769           call store_window_list (iocb_name (terminal_iocb_ptr));
 770           return;
 771 
 772 destroy_all:
 773 destroy_all_windows:
 774      entry (Terminal_iocb_ptr);                             /* No code interesting */
 775           declare iocb_ptr                 pointer;
 776 
 777           terminal_iocb_ptr = Terminal_iocb_ptr;
 778           call get_window_list$$no_create (iocb_name (terminal_iocb_ptr));
 779           if window_list_ptr = null
 780           then return;
 781           do i = 1 to window_list.n_windows;
 782                iocb_ptr = find_iocb (window_list.window_names (i));
 783                call iox_$close (iocb_ptr, (0));
 784                call iox_$detach_iocb (iocb_ptr, (0));
 785           end;
 786           free window_list;
 787           call store_window_list (iocb_name (terminal_iocb_ptr));
 788           return;
 789 
 790 iocb_name:
 791      procedure (iocb_ptr) returns (character (32)) reducible;
 792           declare iocb_ptr                 pointer;
 793           return (iocb_ptr -> iocb.name);
 794      end iocb_name;
 795 
 796 find_iocb:
 797      procedure (iocb_name) returns (pointer);
 798           declare iocb_ptr                 pointer;
 799           declare iocb_name                character (*);
 800 
 801           call iox_$find_iocb (iocb_name, iocb_ptr, (0));
 802           return (iocb_ptr);
 803      end find_iocb;
 804 %page;
 805 
 806 setup_request:
 807      procedure (r_header_ptr, op, l, c);
 808           declare r_header_ptr             pointer;
 809           declare (op, l, c)               fixed bin;
 810 
 811           this_request_ptr, request_ptr = r_header_ptr;
 812 
 813           attach_data.async_count = attach_data.async_count + 1;
 814           call hcs_$set_ips_mask (""b, saved_ips_mask);
 815           request_header.saved_ips_mask = saved_ips_mask;
 816 
 817 /* If there is status pending for this window, return a code.
 818    Raw output handles its own status below. */
 819 
 820           if (op ^= OP_WRITE_RAW) & attach_data.status_pending & ^attach_data.ignore_status
 821           then do;
 822                Code = video_et_$window_status_pending;
 823                go to done;
 824           end;
 825 
 826           this_is_an_input_request =
 827                (op = OP_GET_CHARS_ECHO | op = OP_GET_CHARS_NO_ECHO | op = OP_WRITE_SYNC_GET_CHARS_NO_ECHO
 828                | op = OP_READ_ONE);
 829 
 830           request_header.sentinel = REQUEST_SENTINEL;
 831           request_header.window_id = attach_data.window_id;
 832           request_header.request_id = clock ();
 833           request_header.operation = op;
 834           request_header.row = l + attach_data.line_origin - 1;
 835           request_header.col = c + attach_data.column_origin - 1;
 836           string (request_header.flags) = ""b;
 837 
 838      end setup_request;
 839 ^L
 840 do_request:
 841      procedure (request_ptr);
 842           declare request_ptr              pointer;
 843 
 844           target_iocbp = attach_data.target_iocb_ptr;
 845 
 846 /* terminal control will unmask if it blocks. */
 847 /* we must just note if it signals */
 848 /* the condition handler is elsewhere established to keep this block quick */
 849 /* but this is the right place for the handler to destect ips mask changes
 850    which happen while down in tc. Sigh, I wonder if the cost is worth it --
 851    JR 2/10/85 */
 852 
 853           on cleanup
 854                begin;
 855                     if request_header.saved_ips_mask ^= saved_ips_mask
 856                     then saved_ips_mask = request_header.saved_ips_mask;
 857                end;
 858 
 859           call iox_$control (target_iocbp, "window_operation", request_ptr, Code);
 860           if Code = video_et_$bad_window_id
 861           then begin;                                       /* reconnection, get us a new id if we can */
 862                     declare 1 auto_desk_info         aligned like tc_desk_window_info;
 863                     auto_desk_info.window_id = attach_data.window_id;
 864                     auto_desk_info.first_row = attach_data.line_origin;
 865                     auto_desk_info.n_rows = attach_data.current.rows;
 866                     auto_desk_info.first_column = attach_data.column_origin;
 867                     auto_desk_info.n_columns = attach_data.current.columns;
 868                     auto_desk_info.window_iocb_ptr = real_window_iocb_ptr;
 869                     call iox_$control (target_iocbp, "check_out_window", addr (auto_desk_info), (0));
 870                                                             /* JustinCase */
 871                     call iox_$control (target_iocbp, "check_in_window", addr (auto_desk_info), Code);
 872                     if Code ^= 0
 873                     then go to terminal_control_died;
 874                     attach_data.window_id = auto_desk_info.window_id;
 875                     attach_data.status_pending = "1"b;
 876                     attach_data.status.screen_invalid = "1"b;
 877                     call iox_$control (target_iocbp, "quit_enable", null (), (0));
 878                     Code = video_et_$window_status_pending;
 879                     go to done;
 880                end;
 881 
 882           if ^this_is_an_input_request & request_ptr -> request_header.async_interruption
 883                & request_ptr -> request_header.this_window
 884           then go to ASYNC_EVENT;
 885      end do_request;
 886 ^L
 887 clean_things_up:
 888      procedure;
 889 
 890           attach_data.async_count = max (0, attach_data.async_count - 1);
 891           if saved_ips_mask ^= ""b
 892           then call hcs_$reset_ips_mask (saved_ips_mask, (""b));
 893 
 894           saved_ips_mask = ""b;
 895 
 896           return;
 897 
 898      end clean_things_up;
 899 
 900 /* IMPORTANT: This routine must be invoked before we mask and hack the async
 901    counter because it branches to "error_return", not "done" */
 902 
 903 require_cursor_valid:
 904      procedure;
 905           if ^attach_data.cursor_valid
 906           then do;
 907                Code = video_et_$cursor_position_undefined;
 908                go to error_return;
 909           end;
 910      end require_cursor_valid;
 911 
 912 /* IMPORTANT: This routine must be invoked before we mask and hack the async
 913    counter because it branches to "error_return", not "done" */
 914 
 915 get_attach_data_ptr:
 916      procedure;
 917 
 918           dcl  error_table_$undefined_order_request
 919                                         fixed bin (35) ext static;
 920           dcl  video_et_$wsys_not_invoked
 921                                         fixed bin (35) ext static;
 922 
 923           Code = 0;
 924           real_window_iocb_ptr = null ();
 925           saved_ips_mask = ""b;
 926 
 927           call iox_$control (Iocb_ptr, "get_window_iocb_ptr", real_window_iocb_ptr, Code);
 928           if Code = error_table_$undefined_order_request | real_window_iocb_ptr = null ()
 929                                                             /* discard_ will return a zero error code! */
 930           then Code = video_et_$wsys_not_invoked;           /* much better */
 931           if Code ^= 0
 932           then goto error_return;
 933 
 934           attach_data_ptr = real_window_iocb_ptr -> iocb.attach_data_ptr;
 935           return;
 936 
 937      end get_attach_data_ptr;
 938 ^L
 939 terminal_control_died:                                      /* insert debugging code here */
 940           go to done;
 941 
 942 /* Only branch here if we haven't masked.  This is needed because we might
 943    not even have a valid iocb at this point, so we can't muck with attach
 944    data! */
 945 
 946 error_return:
 947           return;
 948 done:
 949           revert cleanup;                                   /* At least keep things from getting more confused */
 950           call clean_things_up ();
 951           return;
 952 
 953 ASYNC_EVENT:
 954           on cleanup call clean_things_up;
 955           call setup_request (addr (simple_r), OP_GET_CURSOR_POSITION, (0), (0));
 956 
 957           call do_request (addr (simple_r));
 958           if simple_r.row ^< attach_data.line_origin        /* after the top */
 959                & simple_r.row ^> (attach_data.line_origin + attach_data.current.rows - 1)
 960                                                             /* and before the bottom */
 961           then do;                                          /* if the cursor landed in this window */
 962                attach_data.line = simple_r.row;             /* note where */
 963                attach_data.col = simple_r.col;
 964           end;
 965 
 966           attach_data.status_pending = "1"b;
 967           attach_data.status.async_change = "1"b;
 968 
 969           Code = video_et_$window_status_pending;
 970           go to done;
 971 
 972 validate_text:
 973      procedure (text);
 974           declare text                     character (*);
 975           declare printable                character (96)
 976                                            init (
 977                                            " ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890!@#$%^&*()-_=+`~\|{}'"";:/?.>,<[]!"
 978                                            ) internal static options (constant);
 979 
 980           if verify (text, printable) > 0
 981           then do;
 982                Code = video_et_$string_not_printable;
 983                go to done;
 984           end;
 985      end validate_text;
 986 
 987 %include tc_desk_info_;
 988 %page;
 989 %include iox_dcls;
 990 %page;
 991 %include iox_modes;
 992 %page;
 993 %include iocb;
 994 %page;
 995 %include window_control_info;
 996 %page;
 997 %include window_io_attach_data_;
 998 %page;
 999 %include tc_operations_;
1000 
1001      end window_;