os2/OS2/OS2-Process/Process.pm

   1 package OS2::localMorphPM;
   2 # use strict;
   3
   4 sub new {
   5   my ($c,$f) = @_;
   6   OS2::MorphPM($f);
   7   # print STDERR ">>>>>\n";
   8   bless [$f], $c
   9 }
  10 sub DESTROY {
  11   # print STDERR "<<<<<\n";
  12   OS2::UnMorphPM(shift->[0])
  13 }
  14
  15 package OS2::Process;
  16
  17 BEGIN {
  18   require Exporter;
  19   require XSLoader;
  20   #require AutoLoader;
  21
  22   our @ISA = qw(Exporter);
  23   our $VERSION = "1.11";
  24   XSLoader::load('OS2::Process', $VERSION);
  25 }
  26
  27 # Items to export into callers namespace by default. Note: do not export
  28 # names by default without a very good reason. Use EXPORT_OK instead.
  29 # Do not simply export all your public functions/methods/constants.
  30 our @EXPORT = qw(
  31         P_BACKGROUND
  32         P_DEBUG
  33         P_DEFAULT
  34         P_DETACH
  35         P_FOREGROUND
  36         P_FULLSCREEN
  37         P_MAXIMIZE
  38         P_MINIMIZE
  39         P_NOCLOSE
  40         P_NOSESSION
  41         P_NOWAIT
  42         P_OVERLAY
  43         P_PM
  44         P_QUOTE
  45         P_SESSION
  46         P_TILDE
  47         P_UNRELATED
  48         P_WAIT
  49         P_WINDOWED
  50         my_type
  51         file_type
  52         T_NOTSPEC
  53         T_NOTWINDOWCOMPAT
  54         T_WINDOWCOMPAT
  55         T_WINDOWAPI
  56         T_BOUND
  57         T_DLL
  58         T_DOS
  59         T_PHYSDRV
  60         T_VIRTDRV
  61         T_PROTDLL
  62         T_32BIT
  63
  64         os2constant
  65
  66         ppid
  67         ppidOf
  68         sidOf
  69         scrsize
  70         scrsize_set
  71         kbdChar
  72         kbdhChar
  73         kbdStatus
  74         _kbdStatus_set
  75         kbdhStatus
  76         kbdhStatus_set
  77         vioConfig
  78         viohConfig
  79         vioMode
  80         viohMode
  81         viohMode_set
  82         _vioMode_set
  83         _vioState
  84         _vioState_set
  85         vioFont
  86         vioFont_set
  87         process_entry
  88         process_entries
  89         process_hentry
  90         process_hentries
  91         change_entry
  92         change_entryh
  93         process_hwnd
  94         Title_set
  95         Title
  96         winTitle_set
  97         winTitle
  98         swTitle_set
  99         bothTitle_set
 100         WindowText
 101         WindowText_set
 102         WindowPos
 103         WindowPos_set
 104         hWindowPos
 105         hWindowPos_set
 106         WindowProcess
 107         SwitchToProgram
 108         DesktopWindow
 109         ActiveWindow
 110         ActiveWindow_set
 111         ClassName
 112         FocusWindow
 113         FocusWindow_set
 114         ShowWindow
 115         PostMsg
 116         BeginEnumWindows
 117         EndEnumWindows
 118         GetNextWindow
 119         IsWindow
 120         ChildWindows
 121         out_codepage
 122         out_codepage_set
 123         process_codepage_set
 124         in_codepage
 125         in_codepage_set
 126         cursor
 127         cursor_set
 128         screen
 129         screen_set
 130         process_codepages
 131         QueryWindow
 132         WindowFromId
 133         WindowFromPoint
 134         EnumDlgItem
 135         EnableWindow
 136         EnableWindowUpdate
 137         IsWindowEnabled
 138         IsWindowVisible
 139         IsWindowShowing
 140         WindowPtr
 141         WindowULong
 142         WindowUShort
 143         WindowStyle
 144         SetWindowBits
 145         SetWindowPtr
 146         SetWindowULong
 147         SetWindowUShort
 148         WindowBits_set
 149         WindowPtr_set
 150         WindowULong_set
 151         WindowUShort_set
 152         TopLevel
 153         FocusWindow_set_keep_Zorder
 154
 155         ActiveDesktopPathname
 156         InvalidateRect
 157         CreateFrameControls
 158
 159         ClipbrdFmtInfo
 160         ClipbrdOwner
 161         ClipbrdViewer
 162         ClipbrdData
 163         OpenClipbrd
 164         CloseClipbrd
 165         ClipbrdData_set
 166         ClipbrdOwner_set
 167         ClipbrdViewer_set
 168         EnumClipbrdFmts
 169         EmptyClipbrd
 170         ClipbrdFmtNames
 171         ClipbrdFmtAtoms
 172         AddAtom
 173         FindAtom
 174         DeleteAtom
 175         AtomUsage
 176         AtomName
 177         AtomLength
 178         SystemAtomTable
 179         CreateAtomTable
 180         DestroyAtomTable
 181
 182         _ClipbrdData_set
 183         ClipbrdText
 184         ClipbrdText_set
 185         ClipbrdText_2byte
 186         ClipbrdTextUCS2le
 187         MemoryRegionSize
 188
 189         _MessageBox
 190         MessageBox
 191         _MessageBox2
 192         MessageBox2
 193         get_pointer
 194         LoadPointer
 195         SysPointer
 196         Alarm
 197         FlashWindow
 198
 199         get_title
 200         set_title
 201         io_term
 202 );
 203 our @EXPORT_OK = qw(
 204         ResetWinError
 205         MPFROMSHORT
 206         MPVOID
 207         MPFROMCHAR
 208         MPFROM2SHORT
 209         MPFROMSH2CH
 210         MPFROMLONG
 211 );
 212
 213 our $AUTOLOAD;
 214
 215 sub AUTOLOAD {
 216     # This AUTOLOAD is used to 'autoload' constants from the constant()
 217     # XS function.  If a constant is not found then control is passed
 218     # to the AUTOLOAD in AutoLoader.
 219
 220     (my $constname = $AUTOLOAD) =~ s/.*:://;
 221     my $val = constant($constname, @_ ? $_[0] : 0);
 222     if ($! != 0) {
 223         if ($! =~ /Invalid/ || $!{EINVAL}) {
 224             die "Unsupported function $AUTOLOAD"
 225         } else {
 226             my ($pack,$file,$line) = caller;
 227             die "Your vendor has not defined OS2::Process macro $constname, used at $file line $line.
 228 ";
 229         }
 230     }
 231     eval "sub $AUTOLOAD { $val }";
 232     goto &$AUTOLOAD;
 233 }
 234
 235 sub os2constant {
 236   require OS2::Process::Const;
 237   my $sym = shift;
 238   my ($err, $val) = OS2::Process::Const::constant($sym);
 239   die $err if $err;
 240   $val;
 241 }
 242
 243 sub const_import {
 244   require OS2::Process::Const;
 245   my $sym = shift;
 246   my $val = os2constant($sym);
 247   my $p = caller(1);
 248
 249   # no strict;
 250
 251   *{"$p\::$sym"} = sub () { $val };
 252   ();                   # needed by import()
 253 }
 254
 255 sub import {
 256   my $class = shift;
 257   my $ini = @_;
 258   @_ = ($class,
 259         map {
 260           /^(HWND|WM|SC|SWP|WC|PROG|QW|EDI|WS|QWS|QWP|QWL|FF|FI|LS|FS|FCF|BS|MS|TBM|CF|CFI|FID|MB|MBID|CF|CFI|SPTR)_/ ? const_import($_) : $_
 261         } @_);
 262   goto &Exporter::import if @_ > 1 or $ini == 0;
 263 }
 264
 265 # Preloaded methods go here.
 266
 267 sub Title () { (process_entry())[0] }
 268
 269 # *Title_set = \&sesmgr_title_set;
 270
 271 sub swTitle_set_sw {
 272   my ($title, @sw) = @_;
 273   $sw[0] = $title;
 274   change_entry(@sw);
 275 }
 276
 277 sub swTitle_set ($) {
 278   my (@sw) = process_entry();
 279   swTitle_set_sw(shift, @sw);
 280 }
 281
 282 sub winTitle_set_sw {
 283   my ($title, @sw) = @_;
 284   my $h = OS2::localMorphPM->new(0);
 285   WindowText_set $sw[1], $title;
 286 }
 287
 288 sub winTitle_set ($) {
 289   my (@sw) = process_entry();
 290   winTitle_set_sw(shift, @sw);
 291 }
 292
 293 sub winTitle () {
 294   my (@sw) = process_entry();
 295   my $h = OS2::localMorphPM->new(0);
 296   WindowText $sw[1];
 297 }
 298
 299 sub bothTitle_set ($) {
 300   my (@sw) = process_entry();
 301   my $t = shift;
 302   winTitle_set_sw($t, @sw);
 303   swTitle_set_sw($t, @sw);
 304 }
 305
 306 sub Title_set ($) {
 307   my $t = shift;
 308   return 1 if sesmgr_title_set($t);
 309   return 0 unless $^E == 372;
 310   my (@sw) = process_entry();
 311   winTitle_set_sw($t, @sw);
 312   swTitle_set_sw($t, @sw);
 313 }
 314
 315 sub process_entry { swentry_expand(process_swentry(@_)) }
 316
 317 our @hentry_fields = qw( title owner_hwnd icon_hwnd
 318                          owner_phandle owner_pid owner_sid
 319                          visible nonswitchable jumpable ptype sw_entry );
 320
 321 sub swentry_hexpand ($) {
 322   my %h;
 323   @h{@hentry_fields} = swentry_expand(shift);
 324   \%h;
 325 }
 326
 327 sub process_hentry { swentry_hexpand(process_swentry(@_)) }
 328 sub process_hwnd { process_hentry()->{owner_hwnd} }
 329
 330 my $swentry_size = swentry_size();
 331
 332 sub sw_entries () {
 333   my $s = swentries_list();
 334   my ($c, $s1) = unpack 'La*', $s;
 335   die "Inconsistent size in swentries_list()" unless 4+$c*$swentry_size == length $s;
 336   my (@l, $e);
 337   push @l, $e while $e = substr $s1, 0, $swentry_size, '';
 338   @l;
 339 }
 340
 341 sub process_entries () {
 342   map [swentry_expand($_)], sw_entries;
 343 }
 344
 345 sub process_hentries () {
 346   map swentry_hexpand($_), sw_entries;
 347 }
 348
 349 sub change_entry {
 350   change_swentry(create_swentry(@_));
 351 }
 352
 353 sub create_swentryh ($) {
 354   my $h = shift;
 355   create_swentry(@$h{@hentry_fields});
 356 }
 357
 358 sub change_entryh ($) {
 359   change_swentry(create_swentryh(shift));
 360 }
 361
 362 # Massage entries into the same order as WindowPos_set:
 363 sub WindowPos ($) {
 364   my ($fl, $h, $w, $y, $x, $behind, $hwnd, @rest)
 365         = unpack 'L l4 L4', WindowSWP(shift);
 366   ($x, $y, $fl, $w, $h, $behind, @rest);
 367 }
 368
 369 # Put them into a hash
 370 sub hWindowPos ($) {
 371   my %h;
 372   @h{ qw(flags height width y x behind hwnd reserved1 reserved2) }
 373         = unpack 'L l4 L4', WindowSWP(shift);
 374   \%h;
 375 }
 376
 377 my @SWP_keys = ( [qw(width height)],    # SWP_SIZE=1
 378                  [qw(x y)],             # SWP_MOVE=2
 379                  [qw(behind)] );        # SWP_ZORDER=3
 380 my %SWP_def;
 381 @SWP_def{ map @$_, @SWP_keys }  = (0) x 20;
 382
 383 # Get them from a hash
 384 sub hWindowPos_set ($$) {
 385   my $hash = shift;
 386   my $hwnd = (@_ ? shift : $hash->{hwnd} );
 387   my $flags;
 388   if (exists $hash->{flags}) {
 389     $flags = $hash->{flags};
 390   } else {                      # Set flags according to existing keys in $hash
 391     $flags = 0;
 392     for my $bit (0..2) {
 393       exists $hash->{$_} and $flags |= (1<<$bit) for @{$SWP_keys[$bit]};
 394     }
 395   }
 396   for my $bit (0..2) {          # Check for required keys
 397     next unless $flags & (1<<$bit);
 398     exists $hash->{$_}
 399       or die sprintf "key $_ required for flags=%#x", $flags
 400         for @{$SWP_keys[$bit]};
 401   }
 402   my %h = (%SWP_def, flags => $flags, %$hash);          # Avoid warnings
 403   my ($x, $y, $fl, $w, $h, $behind) = @h{ qw(x y flags width height behind) };
 404   WindowPos_set($hwnd, $x, $y, $fl, $w, $h, $behind);
 405 }
 406
 407 sub ChildWindows (;$) {
 408   my $hm = OS2::localMorphPM->new(0);
 409   my @kids;
 410   my $h = BeginEnumWindows(@_ ? shift : 1);     # HWND_DESKTOP
 411   my $w;
 412   push @kids, $w while $w = GetNextWindow $h;
 413   EndEnumWindows $h;
 414   @kids;
 415 }
 416
 417 sub TopLevel ($) {
 418   my $d = DesktopWindow;
 419   my $w = shift;
 420   while (1) {
 421     my $p = QueryWindow $w, 5;  # QW_PARENT;
 422     return $w if not $p or $p == $d;
 423     $w = $p;
 424   }
 425 }
 426
 427 sub FocusWindow_set_keep_Zorder ($) {
 428   my $w = shift;
 429   my $t = TopLevel $w;
 430   my $b = hWindowPos($t)->{behind}; # we are behind this
 431   EnableWindowUpdate($t, 0);
 432   FocusWindow_set($w);
 433 # sleep 1;    # Make flicker stronger when present
 434   hWindowPos_set {behind => $b}, $t;
 435   EnableWindowUpdate($t, 1);
 436 }
 437
 438 sub WindowStyle ($) {
 439   WindowULong(shift,-2);        # QWL_STYLE
 440 }
 441
 442 sub OS2::localClipbrd::new {
 443   my ($c) = shift;
 444   my $morph = [];
 445   push @$morph, OS2::localMorphPM->new(0) unless shift;
 446   &OpenClipbrd;
 447   # print STDERR ">>>>>\n";
 448   bless $morph, $c
 449 }
 450 sub OS2::localClipbrd::DESTROY {
 451   # print STDERR "<<<<<\n";
 452   CloseClipbrd();
 453 }
 454
 455 sub OS2::localFlashWindow::new ($$) {
 456   my ($c, $w) = (shift, shift);
 457   my $morph = OS2::localMorphPM->new(0);
 458   FlashWindow($w, 1);
 459   # print STDERR ">>>>>\n";
 460   bless [$w, $morph], $c
 461 }
 462 sub OS2::localFlashWindow::DESTROY {
 463   # print STDERR "<<<<<\n";
 464   FlashWindow(shift->[0], 0);
 465 }
 466
 467 # Good for \0-terminated text (not "text/unicode" and other Firefox stuff)
 468 sub ClipbrdText (@) {
 469   my $h = OS2::localClipbrd->new;
 470   my $data = ClipbrdData @_;
 471   return unless $data;
 472   my $lim = MemoryRegionSize($data);
 473   $lim = StrLen($data, $lim);                   # Look for 1-byte 0
 474   return unpack "P$lim", pack 'L', $data;
 475 }
 476
 477 sub ClipbrdText_2byte (@) {
 478   my $h = OS2::localClipbrd->new;
 479   my $data = ClipbrdData @_;
 480   return unless $data;
 481   my $lim = MemoryRegionSize($data);
 482   $lim = StrLen($data, $lim, 2);                # Look for 2-byte 0
 483   return unpack "P$lim", pack 'L', $data;
 484 }
 485
 486 sub ClipbrdTextUCS2le (@) {
 487   my $txt = ClipbrdText_2byte @_;               # little-endian shorts
 488   #require Unicode::String;
 489   pack "U*", unpack "v*", $txt;
 490 }
 491
 492 sub ClipbrdText_set ($;@) {
 493   my $h = OS2::localClipbrd->new;
 494   EmptyClipbrd();                               # It may contain other types
 495   my ($txt, $no_convert_nl) = (shift, shift);
 496   ClipbrdData_set($txt, !$no_convert_nl, @_);
 497 }
 498
 499 sub ClipbrdFmtAtoms {
 500   my $h = OS2::localClipbrd->new('nomorph');
 501   my $fmt = 0;
 502   my @formats;
 503   push @formats, $fmt while eval {$fmt = EnumClipbrdFmts $fmt};
 504   die $@ if $@ and $^E == 0x1001 and $fmt = 0;  # Croaks on empty list?
 505   @formats;
 506 }
 507
 508 sub ClipbrdFmtNames {
 509   map AtomName($_), ClipbrdFmtAtoms(@_);
 510 }
 511
 512 sub MessageBox ($;$$$$$) {
 513   my $morph = OS2::localMorphPM->new(0);
 514   die "MessageBox needs text" unless @_;
 515   push @_ , ($0 eq '-e' ? "Perl one-liner's message" : "$0 message") if @_ == 1;
 516   &_MessageBox;
 517 }
 518
 519 my %pointers;
 520
 521 sub get_pointer ($;$$) {
 522   my $id = $_[0];
 523   return $pointers{$id} if exists $pointers{$id};
 524   $pointers{$id} = &SysPointer;
 525 }
 526
 527 # $button needs to be of the form 'String', ['String'] or ['String', flag].
 528 # If ['String'], it is assumed the default button; same for 'String' if $only
 529 # is set.
 530 sub process_MB2 ($$;$) {
 531   die "process_MB2() needs 2 arguments, got '@_'" unless @_ == 2 or @_ == 3;
 532   my ($button, $ret, $only) = @_;
 533   # default is BS_PUSHBUTTON, add BS_DEFAULT if $only is set
 534   $button = [$button, $only ? 0x400 : 0] unless ref $button eq 'ARRAY';
 535   push @$button, 0x400 if @$button == 1; # BS_PUSHBUTTON|BS_DEFAULT
 536   die "Button needs to be of the form 'String', ['String'] or ['String', flag]"
 537     unless @$button == 2;
 538   pack "Z71 x L l", $button->[0], $ret, $button->[1]; # name, retval, flag
 539 }
 540
 541 # If one button, make it the default one even if it is of 'String' => val form.
 542 # If icon is of the form 'SP#<number>', load this via SysPointer.
 543 sub process_MB2_INFO ($;$$$) {
 544   my $l = 0;
 545   my $out;
 546   die "process_MB2_INFO() needs 1..4 arguments" unless @_ and @_ < 5;
 547   my $buttons = shift;
 548   die "Buttons array should consist of pairs" if @$buttons % 2;
 549
 550   push @_, 0 unless @_;         # Icon id; non-0 ignored without MB_CUSTOMICON
 551   # Box flags (MB_MOVABLE and MB_INFORMATION or MB_CUSTOMICON)
 552   push @_, ($_[0] ? 0x4080 : 0x4030) unless @_ > 1;
 553   push @_, 0 unless @_ > 2;     # Notify window
 554
 555   my ($icon, $style, $notify) = (shift, shift, shift);
 556   $icon = get_pointer $1 if $icon =~ /^SP#(\d+)\z/;
 557   $out = pack "L L L L",        # icon, #buttons, style, notify, buttons
 558       $icon, @$buttons/2, $style, $notify;
 559   $out .= join '',
 560     map process_MB2($buttons->[2*$_], $buttons->[2*$_+1], @$buttons == 2),
 561       0..@$buttons/2-1;
 562   pack('L', length(pack 'L', 0) + length $out) . $out;
 563 }
 564
 565 # MessageBox2 'Try this', OS2::Process::process_MB2_INFO([['Dismiss', 0] => 0x1000], OS2::Process::get_pointer(22),0x4080,0), 'me', 1, 0, 0
 566 # or the shortcut
 567 # MessageBox2 'Try this', [[['Dismiss', 0] => 0x1000], 'SP#22'], 'me'
 568 # 0x80 means MB_CUSTOMICON (does not focus?!).  This focuses:
 569 # MessageBox2 'Try this', [[['Dismiss',0x400] => 0x1000], 0, 0x4030,0]
 570 # 0x400 means BS_DEFAULT.  This is the same as the shortcut
 571 # MessageBox2 'Try this', [[Dismiss => 0x1000]]
 572 sub MessageBox2 ($;$$$$$) {
 573   my $morph = OS2::localMorphPM->new(0);
 574   die "MessageBox needs text" unless @_;
 575   push @_ , [[Dismiss => 0x1000], # Name, retval (style BS_PUSHBUTTON|BS_DEFAULT)
 576              #0,                # e.g., get_pointer(11),# SPTR_ICONINFORMATION
 577              #0x4030,           # = MB_MOVEABLE | MB_INFORMATION
 578              #0,                # Notify window; was 1==HWND_DESKTOP
 579             ] if @_ == 1;
 580   push @_ , ($0 eq '-e' ? "Perl one-liner" : $0). "'s message" if @_ == 2;
 581   $_[1] = &process_MB2_INFO(@{$_[1]}) if ref($_[1]) eq 'ARRAY';
 582   &_MessageBox2;
 583 }
 584
 585 my %mbH_default = (
 586   text => 'Something happened',
 587   title => ($0 eq '-e' ? "Perl one-liner" : $0). "'s message",
 588   parent => 1,                  # HWND_DESKTOP
 589   owner => 0,
 590   helpID => 0,
 591   buttons => ['Dismiss' => 0x1000],
 592   default_button => 1,
 593 #  icon => 0x30,                # MB_INFORMATION
 594 #  iconID => 0,                 # XXX???
 595   flags => 0,                   # XXX???
 596   notifyWindow => 0,            # XXX???
 597 );
 598
 599 sub MessageBoxH {
 600   die "MessageBoxH: even number of arguments expected" if @_ % 2;
 601   my %a = (%mbH_default, @_);
 602   die "MessageBoxH: even number of elts of button array expected"
 603     if @{$a{buttons}} % 2;
 604   if (defined $a{iconID}) {
 605     $a{flags} |= 0x80;          # MB_CUSTOMICON
 606   } else {
 607     $a{icon} = 0x30 unless defined $a{icon};
 608     $a{iconID} = 0;
 609     $a{flags} |= $a{icon};
 610   }
 611   # Mark default_button as MessageBox2() expects it:
 612   $a{buttons}[2*$a{default_button}] = [$a{buttons}[2*$a{default_button}]];
 613
 614   my $use_2 = 'ARRAY' eq ref $a{buttons};
 615   return
 616     MessageBox2 $a{text}, [@a{qw(buttons iconID flags notifyWindow)}],
 617       $a{parent}, $a{owner}, $a{helpID}
 618         if $use_2;
 619   die "MessageBoxH: unexpected format of argument 'buttons'";
 620 }
 621
 622 # backward compatibility
 623 *set_title = \&Title_set;
 624 *get_title = \&Title;
 625
 626 # New (logical) names
 627 *WindowBits_set = \&SetWindowBits;
 628 *WindowPtr_set = \&SetWindowPtr;
 629 *WindowULong_set = \&SetWindowULong;
 630 *WindowUShort_set = \&SetWindowUShort;
 631
 632 # adapter; display; cbMemory; Configuration; VDHVersion; Flags; HWBufferSize;
 633 # FullSaveSize; PartSaveSize; EMAdaptersOFF; EMDisplaysOFF;
 634 sub vioConfig (;$$) {
 635   my $data = &_vioConfig;
 636   my @out = unpack 'x[S]SSLSSSLLLSS', $data;
 637   # If present, offset points to S/S (with only the first work making sense)
 638   my (@adaptersEMU, @displayEMU);
 639   @displaysEMU = unpack("x[$out[10]]S/S", $data), pop @out if @out > 10;
 640   @adaptersEMU = unpack("x[$out[ 9]]S/S", $data), pop @out if @out > 9;
 641   $out[9] = $adaptersEMU[0] if @adaptersEMU;
 642   $out[10] = $displaysEMU[0] if @displaysEMU;
 643   @out;
 644 }
 645
 646 my @vioConfig = qw(adapter display cbMemory Configuration VDHVersion Flags
 647                    HWBufferSize FullSaveSize PartSaveSize EMAdapters EMDisplays);
 648
 649 sub viohConfig (;$$) {
 650   my %h;
 651   @h{@vioConfig} = &vioConfig;
 652   %h;
 653 }
 654
 655 # fbType; color; col; row; hres; vres; fmt_ID; attrib; buf_addr; buf_length;
 656 # full_length; partial_length; ext_data_addr;
 657 sub vioMode() {unpack 'x[S]CCSSSSCCLLLLL', _vioMode}
 658
 659 my @vioMode = qw( fbType color col row hres vres fmt_ID attrib buf_addr
 660                   buf_length full_length partial_length ext_data_addr);
 661
 662 sub viohMode() {
 663   my %h;
 664   @h{@vioMode} = vioMode;
 665   %h;
 666 }
 667
 668 sub viohMode_set {
 669   my %h = (viohMode, @_);
 670   my $o = pack 'x[S]CCSSSSCCLLLLL', @h{@vioMode};
 671   $o = pack 'SCCSSSSCCLLLLL', length $o, @h{@vioMode};
 672   _vioMode_set($o);
 673 }
 674
 675 sub kbdChar (;$$) {unpack 'CCCCSL', &_kbdChar}
 676
 677 my @kbdChar = qw(ascii scancode status nlsstate shifts time);
 678 sub kbdhChar (;$$) {
 679   my %h;
 680   @h{@kbdChar} = &kbdChar;
 681   %h
 682 }
 683
 684 sub kbdStatus (;$) {unpack 'x[S]SSSS', &_kbdStatus}
 685 my @kbdStatus = qw(state turnChar intCharFlags shifts);
 686 sub kbdhStatus (;$) {
 687   my %h;
 688   @h{@kbdStatus} = &kbdStatus;
 689   %h
 690 }
 691 sub kbdhStatus_set {
 692   my $h = (@_ % 2 ? shift @_ : 0);
 693   my %h = (kbdhStatus($h), @_);
 694   my $o = pack 'x[S]SSSS', @h{@kbdStatus};
 695   $o = pack 'SSSSS', length $o, @h{@kbdStatus};
 696   _kbdStatus_set($o,$h);
 697 }
 698
 699 #sub DeleteAtom         { !WinDeleteAtom(@_) }
 700 sub DeleteAtom          { !_DeleteAtom(@_) }
 701 sub DestroyAtomTable    { !_DestroyAtomTable(@_) }
 702
 703 # XXXX This is a wrong order: we start keyreader, then screenwriter; so it is
 704 # the writer who gets signals.
 705
 706 # XXXX Do we ever get a message "screenwriter killed"???  If reader HUPs us...
 707 # Large buffer works at least for read from pipes; should we binmode???
 708 sub __term_mirror_screen {   # Read from fd=$in and write to the console
 709   local $SIG{TERM} = $SIG{HUP} = $SIG{BREAK} = $SIG{INT} = # die() can stop END
 710     sub { my $s = shift; warn "screenwriter killed ($s)...\n";};
 711   my $in = shift;
 712   open IN, "<&=$in" or die "open <&=$in: $!";
 713   # Attempt to redirect to STDERR/OUT is not very useful, but try this anyway...
 714   open OUT, '>', '/dev/con' or open OUT, '>&STDERR' or open OUT, '>&STDOUT'
 715         and select OUT or die "Can't open /dev/con or STDERR/STDOUT for write";
 716   $| = 1; local $SIG{TERM} = sub { die "screenwriter exits...\n"};
 717   binmode IN; binmode OUT;
 718   eval { print $_ while sysread IN, $_, 1<<16; };       # print to OUT...
 719   warn $@ if $@;
 720   warn "Screenwriter can't read any more ($!, $^E), terminating...\n";
 721 }
 722
 723 # Does not automatically ends when the parent exits if related => 0
 724 # copy from fd=$in to screen ; same for $out; or $in may be a named pipe
 725 sub __term_mirror {
 726   my $pid;
 727   ### If related => 1, we get TERM when our parent exits...
 728   local $SIG{TERM} = sub { my $s = shift;
 729                            die "keyreader exits in a few secs ($s)...\n" };
 730   my ($in, $out) = (shift, shift);
 731   if (defined $out and length $out) {   # Allow '' for ease of @ARGV
 732     open OUT, ">&=$out" or die "Cannot open &=$out for write: $!";
 733     fcntl(OUT, 4, 1);           # F_SETFD, NOINHERIT
 734     open IN, "<&=$in" or die "Cannot open &=$in for read/ioctl: $!";
 735     fcntl(IN,  4, 0);           # F_SETFD, INHERIT
 736   } else {
 737     warn "Unexpected i/o pipe name: `$in'" unless $in =~ m,^[\\/]pipe[\\/],i;
 738     OS2::pipe $in, 'wait';
 739     open OUT, '+<', $in or die "Can't open `$in' for r/w: $!";
 740     fcntl(OUT,  4, 0);          # F_SETFD, INHERIT
 741     $in = fileno OUT;
 742     undef $out;
 743   }
 744   my %opt = @_;
 745   Title_set $opt{title}                         if exists $opt{title};
 746   &scrsize_set(split /,/, $opt{scrsize})        if exists $opt{scrsize};
 747
 748   my @i = map +('-I', $_), @INC;        # Propagate @INC
 749
 750   # Careful unless PERL_SIGNALS=unsafe: SIGCHLD does not work...
 751   $SIG{CHLD} = sub {wait; die "Keyreader follows screenwriter...\n"}
 752         unless defined $out;
 753
 754   $pid = system 1, $^X, @i, '-MOS2::Process',
 755          '-we', 'END {sleep 2} OS2::Process::__term_mirror_screen shift', $in;
 756   close IN if defined $out;
 757   $pid > 0 or die "Cannot start a grandkid";
 758
 759   open STDIN, '</dev/con' or warn "reopen stdin: $!";
 760   select OUT;    $| = 1;  binmode OUT;  # need binmode: sysread() may be bin
 761   $SIG{PIPE} = sub { die "writing to a closed pipe" };
 762   $SIG{HUP} = $SIG{BREAK} = $SIG{INT} = $SIG{TERM};
 763   # Workaround: EMX v61 won't return pid on SESSION|UNRELATED after fork()...
 764   syswrite OUT, pack 'L', $$ or die "syswrite failed: $!" if $opt{writepid};
 765   # Turn Nodelay on kbd.  Pipe is automatically nodelay...
 766   if ($opt{read_by_key}) {
 767     if (eval {require Term::ReadKey; 1}) {
 768       Term::ReadKey::ReadMode(4);
 769     } else { warn "can't load Term::ReadKey; input by lines..." }
 770   }
 771   print while sysread STDIN, $_, 1<<($opt{smallbuffer} ? 0 : 16); # to OUT
 772 }
 773
 774 my $c = 0;
 775 sub io_term {   # arguments as hash: read_by_key/title/scrsize/related/writepid
 776   # read_by_key disables echo too...
 777   local $\  = '';
 778   my ($sysf, $in1, $out1, $in2, $out2, $f1, $f2, $fd) = 4;      # P_SESSION
 779   my %opt = @_;
 780
 781   if ($opt{related}) {
 782     pipe $in1, $out1 or die "pipe(): $!";
 783     pipe $in2, $out2 or do { close($in1), close($out1), die "pipe(): $!" };
 784     $f1 = fileno $in1; $f2 = fileno $out2;
 785     fcntl($in2, 4, 1); fcntl($out1, 4, 1);              # F_SETFD, NOINHERIT
 786     fcntl($in1, 4, 0); fcntl($out2, 4, 0);              # F_SETFD, INHERIT
 787   } else {
 788     $f1 = "/pipe/perlmodule/OS2/Process/$$-" . $c++;
 789     $out1 = OS2::pipe $f1, 'rw' or die "OS2::pipe(): $^E";
 790     #open $out1, "+<&=$fd" or die "dup($fd): $!, $^E";
 791     fcntl($out1, 4, 1);         # F_SETFD, NOINHERIT
 792     #$in2 = $out1;
 793     $f2 = '';
 794     $sysf |= 0x40000;           # P_UNRELATED
 795     $opt{writepid} = 1, unless exists $opt{writepid};
 796   }
 797
 798   # system P_SESSION will fail if there is another process
 799   # in the same session with a "related" asynchronous child session.
 800   my @i = map +('-I', $_), @INC;        # Propagate @INC
 801   my $krun = <<'EOS';
 802      END {sleep($sleep || 5)}
 803      use OS2::Process; $sleep = 1;
 804      OS2::Process::__term_mirror(@ARGV);
 805 EOS
 806   my $kpid;
 807   if ($opt{related}) {
 808     $kpid = system $sysf, $^X, @i, '-we', $krun, $f1, $f2, %opt;
 809   } else {
 810     local $ENV{PERL_SIGNALS} = 'unsafe';
 811     $kpid = system $sysf, $^X, @i, '-we', $krun, $f1, $f2, %opt;
 812   }
 813   close $in1 or warn if defined $in1;
 814   close $out2 or warn if defined $out2;
 815   # EMX BUG with $kpid == 0 after fork()
 816   do { close($in2), ($out1 != $in2 and close($out1)),
 817        die "system $sysf, $^X: kid=$kpid, \$!=`$!', \$^E=`$^E'" }
 818      unless $kpid > 0 or $kpid == 0 and $opt{writepid};
 819   # Can't read or write until the kid opens the pipes
 820   OS2::pipeCntl $out1, 'connect', 'wait' unless length $f2;
 821   # Without duping: write after read (via termio) on the same fd dups input
 822   open $in2, '<&', $out1 or die "dup($out1): $^E" unless $opt{related};
 823   if ($opt{writepid}) {
 824     my $c = length pack 'L', 0;
 825     my $c1 = sysread $in2, (my $pid), $c;
 826     $c1 == $c or die "unexpected length read: $c1 vs $c";
 827     $kpid = unpack 'L', $pid;
 828   }
 829   return ($in2, $out1, $kpid);
 830 }
 831
 832 # Autoload methods go after __END__, and are processed by the autosplit program.
 833
 834 1;
 835 __END__
 836
 837 =head1 NAME
 838
 839 OS2::Process - exports constants for system() call, and process control on OS2.
 840
 841 =head1 SYNOPSIS
 842
 843     use OS2::Process;
 844     $pid = system(P_PM | P_BACKGROUND, "epm.exe");
 845
 846 =head1 DESCRIPTION
 847
 848 =head2 Optional argument to system()
 849
 850 the builtin function system() under OS/2 allows an optional first
 851 argument which denotes the mode of the process. Note that this argument is
 852 recognized only if it is strictly numerical.
 853
 854 You can use either one of the process modes:
 855
 856         P_WAIT (0)      = wait until child terminates (default)
 857         P_NOWAIT        = do not wait until child terminates
 858         P_SESSION       = new session
 859         P_DETACH        = detached
 860         P_PM            = PM program
 861
 862 and optionally add PM and session option bits:
 863
 864         P_DEFAULT (0)   = default
 865         P_MINIMIZE      = minimized
 866         P_MAXIMIZE      = maximized
 867         P_FULLSCREEN    = fullscreen (session only)
 868         P_WINDOWED      = windowed (session only)
 869
 870         P_FOREGROUND    = foreground (if running in foreground)
 871         P_BACKGROUND    = background
 872
 873         P_NOCLOSE       = don't close window on exit (session only)
 874
 875         P_QUOTE         = quote all arguments
 876         P_TILDE         = MKS argument passing convention
 877         P_UNRELATED     = do not kill child when father terminates
 878
 879 =head2 Access to process properties
 880
 881 On OS/2 processes have the usual I<parent/child> semantic;
 882 additionally, there is a hierarchy of sessions with their own
 883 I<parent/child> tree.  A session is either a FS session, or a windowed
 884 pseudo-session created by PM.  A session is a "unit of user
 885 interaction", a change to in/out settings in one of them does not
 886 affect other sessions.
 887
 888 =over
 889
 890 =item my_type()
 891
 892 returns the type of the current process (one of
 893 "FS", "DOS", "VIO", "PM", "DETACH" and "UNKNOWN"), or C<undef> on error.
 894
 895 =item C<file_type(file)>
 896
 897 returns the type of the executable file C<file>, or
 898 dies on error.  The bits 0-2 of the result contain one of the values
 899
 900 =over
 901
 902 =item C<T_NOTSPEC> (0)
 903
 904 Application type is not specified in the executable header.
 905
 906 =item C<T_NOTWINDOWCOMPAT> (1)
 907
 908 Application type is not-window-compatible.
 909
 910 =item C<T_WINDOWCOMPAT> (2)
 911
 912 Application type is window-compatible.
 913
 914 =item C<T_WINDOWAPI> (3)
 915
 916 Application type is window-API.
 917
 918 =back
 919
 920 The remaining bits should be masked with the following values to
 921 determine the type of the executable:
 922
 923 =over
 924
 925 =item C<T_BOUND> (8)
 926
 927 Set to 1 if the executable file has been "bound" (by the BIND command)
 928 as a Family API application. Bits 0, 1, and 2 still apply.
 929
 930 =item C<T_DLL> (0x10)
 931
 932 Set to 1 if the executable file is a dynamic link library (DLL)
 933 module. Bits 0, 1, 2, 3, and 5 will be set to 0.
 934
 935 =item C<T_DOS> (0x20)
 936
 937 Set to 1 if the executable file is in PC/DOS format. Bits 0, 1, 2, 3,
 938 and 4 will be set to 0.
 939
 940 =item C<T_PHYSDRV> (0x40)
 941
 942 Set to 1 if the executable file is a physical device driver.
 943
 944 =item C<T_VIRTDRV> (0x80)
 945
 946 Set to 1 if the executable file is a virtual device driver.
 947
 948 =item C<T_PROTDLL> (0x100)
 949
 950 Set to 1 if the executable file is a protected-memory dynamic link
 951 library module.
 952
 953 =item C<T_32BIT> (0x4000)
 954
 955 Set to 1 for 32-bit executable files.
 956
 957 =back
 958
 959 file_type() may croak with one of the strings C<"Invalid EXE
 960 signature"> or C<"EXE marked invalid"> to indicate typical error
 961 conditions.  If given non-absolute path, will look on C<PATH>, will
 962 add extension F<.exe> if no extension is present (add extension F<.>
 963 to suppress).
 964
 965 =item C<@list = process_codepages()>
 966
 967 the first element is the currently active codepage, up to 2 additional
 968 entries specify the system's "prepared codepages": the codepages the
 969 user can switch to.  The active codepage of a process is one of the
 970 prepared codepages of the system (if present).
 971
 972 =item C<process_codepage_set($cp)>
 973
 974 sets the currently active codepage.  [Affects printer output, in/out
 975 codepages of sessions started by this process, and the default
 976 codepage for drawing in PM; is inherited by kids.  Does not affect the
 977 out- and in-codepages of the session.]
 978
 979 =item ppid()
 980
 981 returns the PID of the parent process.
 982
 983 =item C<ppidOf($pid = $$)>
 984
 985 returns the PID of the parent process of $pid.  -1 on error.
 986
 987 =item C<sidOf($pid = $$)>
 988
 989 returns the session id of the process id $pid.  -1 on error.
 990
 991 =back
 992
 993 =head2 Control of VIO sessions
 994
 995 VIO applications are applications running in a text-mode session.
 996
 997 =over
 998
 999 =item out_codepage()
1000
1001 gets code page used for screen output (glyphs).  -1 means that a user font
1002 was loaded.
1003
1004 =item C<out_codepage_set($cp)>
1005
1006 sets code page used for screen output (glyphs).  -1 switches to a preloaded
1007 user font.  -2 switches off the preloaded user font.
1008
1009 =item in_codepage()
1010
1011 gets code page used for keyboard input.  0 means that a hardware codepage
1012 is used.
1013
1014 =item C<in_codepage_set($cp)>
1015
1016 sets code page used for keyboard input.
1017
1018 =item C<($w, $h) = scrsize()>
1019
1020 width and height of the given console window in character cells.
1021
1022 =item C<scrsize_set([$w, ] $h)>
1023
1024 set height (and optionally width) of the given console window in
1025 character cells.  Use 0 size to keep the old size.
1026
1027 =item C<($s, $e, $w, $a) = cursor()>
1028
1029 gets start/end lines of the blinking cursor in the charcell, its width
1030 (1 on text modes) and attribute (-1 for hidden, in text modes other
1031 values mean visible, in graphic modes color).
1032
1033 =item C<cursor_set($s, $e, [$w [, $a]])>
1034
1035 sets start/end lines of the blinking cursor in the charcell.  Negative
1036 values mean percents of the character cell height.
1037
1038 =item screen()
1039
1040 gets a buffer with characters and attributes of the screen.
1041
1042 =item C<screen_set($buffer)>
1043
1044 restores the screen given the result of screen().  E.g., if the file
1045 C<$file> contains the screen contents, then
1046
1047   open IN, $file or die;
1048   binmode IN;
1049   read IN, $in, -s IN;
1050   $s = screen;
1051   $in .= qq(\0) x (length($s) - length $in);
1052   substr($in, length $s) = '';
1053   screen_set $in;
1054
1055 will restore the screen content even if the height of the window
1056 changed (if the width changed, more manipulation is needed).
1057
1058 =back
1059
1060 =head2 Control of the process list
1061
1062 With the exception of Title_set(), all these calls require that PM is
1063 running, they would not work under alternative Session Managers.
1064
1065 =over
1066
1067 =item process_entry()
1068
1069 returns a list of the following data:
1070
1071 =over
1072
1073 =item *
1074
1075 Title of the process (in the C<Ctrl-Esc> list);
1076
1077 =item *
1078
1079 window handle of switch entry of the process (in the C<Ctrl-Esc> list);
1080
1081 =item *
1082
1083 window handle of the icon of the process;
1084
1085 =item *
1086
1087 process handle of the owner of the entry in C<Ctrl-Esc> list;
1088
1089 =item *
1090
1091 process id of the owner of the entry in C<Ctrl-Esc> list;
1092
1093 =item *
1094
1095 session id of the owner of the entry in C<Ctrl-Esc> list;
1096
1097 =item *
1098
1099 whether visible in C<Ctrl-Esc> list;
1100
1101 =item *
1102
1103 whether item cannot be switched to (note that it is not actually
1104 grayed in the C<Ctrl-Esc> list));
1105
1106 =item *
1107
1108 whether participates in jump sequence;
1109
1110 =item *
1111
1112 program type.  Possible values are:
1113
1114      PROG_DEFAULT                       0
1115      PROG_FULLSCREEN                    1
1116      PROG_WINDOWABLEVIO                 2
1117      PROG_PM                            3
1118      PROG_VDM                           4
1119      PROG_WINDOWEDVDM                   7
1120
1121 Although there are several other program types for WIN-OS/2 programs,
1122 these do not show up in this field. Instead, the PROG_VDM or
1123 PROG_WINDOWEDVDM program types are used. For instance, for
1124 PROG_31_STDSEAMLESSVDM, PROG_WINDOWEDVDM is used. This is because all
1125 the WIN-OS/2 programs run in DOS sessions. For example, if a program
1126 is a windowed WIN-OS/2 program, it runs in a PROG_WINDOWEDVDM
1127 session. Likewise, if it's a full-screen WIN-OS/2 program, it runs in
1128 a PROG_VDM session.
1129
1130 =item *
1131
1132 switch-entry handle.
1133
1134 =back
1135
1136 Optional arguments: the pid and the window-handle of the application running
1137 in the OS/2 session to query.
1138
1139 =item process_hentry()
1140
1141 similar to process_entry(), but returns a hash reference, the keys being
1142
1143   title owner_hwnd icon_hwnd owner_phandle owner_pid owner_sid
1144   visible nonswitchable jumpable ptype sw_entry
1145
1146 (a copy of the list of keys is in @hentry_fields).
1147
1148 =item process_entries()
1149
1150 similar to process_entry(), but returns a list of array reference for all
1151 the elements in the switch list (one controlling C<Ctrl-Esc> window).
1152
1153 =item process_hentries()
1154
1155 similar to process_hentry(), but returns a list of hash reference for all
1156 the elements in the switch list (one controlling C<Ctrl-Esc> window).
1157
1158 =item change_entry()
1159
1160 changes a process entry, arguments are the same as process_entry() returns.
1161
1162 =item change_entryh()
1163
1164 Similar to change_entry(), but takes a hash reference as an argument.
1165
1166 =item process_hwnd()
1167
1168 returns the C<owner_hwnd> of the process entry (for VIO windowed processes
1169 this is the frame window of the session).
1170
1171 =item Title()
1172
1173 returns the text of the task switch menu entry of the current session.
1174 (There is no way to get this info in non-standard Session Managers.  This
1175 implementation is a shortcut via process_entry().)
1176
1177 =item C<Title_set(newtitle)>
1178
1179 tries two different interfaces.  The Session Manager one does not work
1180 with some windows (if the title is set from the start).
1181 This is a limitation of OS/2, in such a case $^E is set to 372 (type
1182
1183   help 372
1184
1185 for a funny - and wrong  - explanation ;-).  In such cases a
1186 direct-manipulation of low-level entries is used (same as bothTitle_set()).
1187 Keep in mind that some versions of OS/2 leak memory with such a manipulation.
1188
1189 =item winTitle()
1190
1191 returns text of the titlebar of the current process' window.
1192
1193 =item C<winTitle_set(newtitle)>
1194
1195 sets text of the titlebar of the current process' window.  The change does not
1196 affect the text of the switch entry of the current window.
1197
1198 =item C<swTitle_set(newtitle)>
1199
1200 sets text of the task switch menu entry of the current process' window.  [There
1201 is no API to query this title.]  Does it via SwitchEntry interface,
1202 not Session manager interface.  The change does not affect the text of the
1203 titlebar of the current window.
1204
1205 =item C<bothTitle_set(newtitle)>
1206
1207 sets text of the titlebar and task switch menu of the current process' window
1208 via direct manipulation of the windows' texts.
1209
1210 =item C<SwitchToProgram([$sw_entry])>
1211
1212 switch to session given by a switch list handle (defaults to the entry of our process).
1213
1214 Use of this function causes another window (and its related windows)
1215 of a PM session to appear on the front of the screen, or a switch to
1216 another session in the case of a non-PM program. In either case,
1217 the keyboard (and mouse for the non-PM case) input is directed to
1218 the new program.
1219
1220 =back
1221
1222 =head2 Control of the PM windows
1223
1224 Some of these API's require sending a message to the specified window.
1225 In such a case the process needs to be a PM process, or to be morphed
1226 to a PM process via OS2::MorphPM().
1227
1228 For a temporary morphing to PM use the L<OS2::localMorphPM|/OS2::localMorphPM,
1229 OS2::localFlashWindow, and OS2::localClipbrd classes> class.
1230
1231 Keep in mind that PM windows are engaged in 2 "orthogonal" window
1232 trees, as well as in the z-order list.
1233
1234 One tree is given by the I<parent/child> relationship.  This
1235 relationship affects drawing (child is drawn relative to its parent
1236 (lower-left corner), and the drawing is clipped by the parent's
1237 boundary; parent may request that I<it's> drawing is clipped to be
1238 confined to the outsize of the child's and/or siblings' windows);
1239 hiding; minimizing/restoring; and destroying windows.
1240
1241 Another tree (not necessarily connected?) is given by I<ownership>
1242 relationship.  Ownership relationship assumes cooperation of the
1243 engaged windows via passing messages on "important events"; e.g.,
1244 scrollbars send information messages when the "bar" is moved, menus
1245 send messages when an item is selected; frames
1246 move/hide/unhide/minimize/restore/change-z-order-of owned frames when
1247 the owner is moved/etc., and destroy the owned frames (even when these
1248 frames are not descendants) when the owner is destroyed; etc.  [An
1249 important restriction on ownership is that owner should be created by
1250 the same thread as the owned thread, so they engage in the same
1251 message queue.]
1252
1253 Windows may be in many different state: Focused (take keyboard events) or not,
1254 Activated (=Frame windows in the I<parent/child> tree between the root and
1255 the window with the focus; usually indicate such "active state" by titlebar
1256 highlights, and take mouse events) or not, Enabled/Disabled (this influences
1257 the ability to update the graphic, and may change appearance, as for
1258 enabled/disabled buttons), Visible/Hidden, Minimized/Maximized/Restored, Modal
1259 or not, etc.
1260
1261 The APIs below all die() on error with the message being $^E.
1262
1263 =over
1264
1265 =item C<WindowText($hwnd)>
1266
1267 gets "a text content" of a window.  Requires (morphing to) PM.
1268
1269 =item C<WindowText_set($hwnd, $text)>
1270
1271 sets "a text content" of a window.  Requires (morphing to) PM.
1272
1273 =item C<($x, $y, $flags, $width, $height, $behind, @rest) = WindowPos($hwnd)>
1274
1275 gets window position info as 8 integers (of C<SWP>), in the order suitable
1276 for WindowPos_set().  @rest is marked as "reserved" in PM docs.  $flags
1277 is a combination of C<SWP_*> constants.
1278
1279 =item C<$hash = hWindowPos($hwnd)>
1280
1281 gets window position info as a hash reference; the keys are C<flags width
1282 height x y behind hwnd reserved1 reserved2>.
1283
1284 Example:
1285
1286   exit unless $hash->{flags} & SWP_MAXIMIZE;    # Maximized
1287
1288 =item C<WindowPos_set($hwnd, $x, $y, $flags = SWP_MOVE, $width = 0, $height = 0, $behind = HWND_TOP)>
1289
1290 Set state of the window: position, size, zorder, show/hide, activation,
1291 minimize/maximize/restore etc.  Which of these operations to perform
1292 is governed by $flags.
1293
1294 =item C<hWindowPos_set($hash, [$hwnd])>
1295
1296 Same as C<WindowPos_set>, but takes the position from keys C<fl width height
1297 x y behind hwnd> of the hash referenced by $hash.  If $hwnd is explicitly
1298 specified, it overrides C<< $hash->{hwnd} >>.  If $hash->{flags} is not specified,
1299 it is calculated basing on the existing keys of $hash.  Requires (morphing to) PM.
1300
1301 Example:
1302
1303   hWindowPos_set {flags => SWP_MAXIMIZE}, $hwnd; # Maximize
1304
1305 =item C<($pid, $tid) = WindowProcess($hwnd)>
1306
1307 gets I<PID> and I<TID> of the process associated to the window.
1308
1309 =item C<ClassName($hwnd)>
1310
1311 returns the class name of the window.
1312
1313 If this window is of any of the preregistered WC_* classes the class
1314 name returned is in the form "#nnnnn", where "nnnnn" is a group
1315 of up to five digits that corresponds to the value of the WC_* class name
1316 constant.
1317
1318 =item WindowStyle($hwnd)
1319
1320 Returns the "window style" flags for window handle $hwnd.
1321
1322 =item WindowULong($hwnd, $id), WindowPtr($hwnd, $id), WindowUShort($hwnd, $id)
1323
1324 Return data associated to window handle $hwnd.  $id should be one of
1325 C<QWL_*>, C<QWP_PFNWP>, C<QWS_*> constants, or a byte offset referencing
1326 a region (of length 4, 4, 2 correspondingly) fully inside C<0..cbWindowData-1>.
1327 Here C<cbWindowData> is the count of extra user-specified bytes reserved
1328 for the given class of windows.
1329
1330 =item WindowULong_set($hwnd, $id, $value), WindowPtr_set, WindowUShort_set
1331
1332 Similar to WindowULong(), WindowPtr(), WindowUShort(), but for assigning the
1333 value $value.
1334
1335 =item WindowBits_set($hwnd, $id, $value, $mask)
1336
1337 Similar to WindowULong_set(), but will change only the bits which are
1338 set in $mask.
1339
1340 =item FocusWindow()
1341
1342 returns the handle of the focus window.  Optional argument for specifying
1343 the desktop to use.
1344
1345 =item C<FocusWindow_set($hwnd)>
1346
1347 set the focus window by handle.  Optional argument for specifying the desktop
1348 to use.  E.g, the first entry in program_entries() is the C<Ctrl-Esc> list.
1349 To show an application, use either one of
1350
1351        WinShowWindow( $hwnd, 1 );
1352        FocusWindow_set( $hwnd );
1353        SwitchToProgram($switch_handle);
1354
1355 (Which work with alternative focus-to-front policies?)  Requires
1356 (morphing to) PM.
1357
1358 Switching focus to currently-unfocused window moves the window to the
1359 front in Z-order; use FocusWindow_set_keep_Zorder() to avoid this.
1360
1361 =item C<FocusWindow_set_keep_Zorder($hwnd)>
1362
1363 same as FocusWindow_set(), but preserves the Z-order of windows.
1364
1365 =item C<ActiveWindow([$parentHwnd])>
1366
1367 gets the active subwindow's handle for $parentHwnd or desktop.
1368 Returns FALSE if none.
1369
1370 =item C<ActiveWindow_set($hwnd, [$parentHwnd])>
1371
1372 sets the active subwindow's handle for $parentHwnd or desktop.  Requires (morphing to) PM.
1373
1374 =item C<ShowWindow($hwnd [, $show])>
1375
1376 Set visible/hidden flag of the window.  Default: $show is TRUE.
1377
1378 =item C<EnableWindowUpdate($hwnd [, $update])>
1379
1380 Set window visibility state flag for the window for subsequent drawing.
1381 No actual drawing is done at this moment.  Use C<ShowWindow($hwnd, $state)>
1382 when redrawing is needed.  While update is disabled, changes to the "window
1383 state" do not change the appearance of the window.  Default: $update is TRUE.
1384
1385 (What is manipulated is the bit C<WS_VISIBLE> of the window style.)
1386
1387 =item C<EnableWindow($hwnd [, $enable])>
1388
1389 Set the window enabled state.  Default: $enable is TRUE.
1390
1391 Results in C<WM_ENABLED> message sent to the window.  Typically, this
1392 would change the appearance of the window.  If at the moment of disabling
1393 focus is in the window (or a descendant), focus is lost (no focus anywhere).
1394 If focus is needed, it can be reassigned explicitly later.
1395
1396 =item IsWindowEnabled(), IsWindowVisible(), IsWindowShowing()
1397
1398 these functions take $hwnd as an argument.  IsWindowEnabled() queries
1399 the state changed by EnableWindow(), IsWindowVisible() the state changed
1400 by ShowWindow(), IsWindowShowing() is true if there is a part of the window
1401 visible on the screen.
1402
1403 =item C<PostMsg($hwnd, $msg, $mp1, $mp2)>
1404
1405 post message to a window.  The meaning of $mp1, $mp2 is specific for each
1406 message id $msg, they default to 0.  E.g.,
1407
1408   use OS2::Process qw(:DEFAULT WM_SYSCOMMAND WM_CONTEXTMENU
1409                       WM_SAVEAPPLICATION WM_QUIT WM_CLOSE
1410                       SC_MAXIMIZE SC_RESTORE);
1411   $hwnd = process_hentry()->{owner_hwnd};
1412   # Emulate choosing `Restore' from the window menu:
1413   PostMsg $hwnd, WM_SYSCOMMAND, MPFROMSHORT(SC_RESTORE); # Not
1414                                                          # immediate
1415
1416   # Emulate `Show-Contextmenu' (Double-Click-2), two ways:
1417   PostMsg ActiveWindow, WM_CONTEXTMENU;
1418   PostMsg FocusWindow, WM_CONTEXTMENU;
1419
1420   /* Emulate `Close' */
1421   PostMsg ActiveWindow, WM_CLOSE;
1422
1423   /* Same but with some "warnings" to the application */
1424   $hwnd = ActiveWindow;
1425   PostMsg $hwnd, WM_SAVEAPPLICATION;
1426   PostMsg $hwnd, WM_CLOSE;
1427   PostMsg $hwnd, WM_QUIT;
1428
1429 In fact, MPFROMSHORT() may be omitted above.
1430
1431 For messages to other processes, messages which take/return a pointer are
1432 not supported.
1433
1434 =item C<MP*()>
1435
1436 The functions MPFROMSHORT(), MPVOID(), MPFROMCHAR(), MPFROM2SHORT(),
1437 MPFROMSH2CH(), MPFROMLONG() can be used the same way as from C.  Use them
1438 to construct parameters $m1, $m2 to PostMsg().
1439
1440 These functions are not exported by default.
1441
1442 =item C<$eh = BeginEnumWindows($hwnd)>
1443
1444 starts enumerating immediate child windows of $hwnd in z-order.  The
1445 enumeration reflects the state at the moment of BeginEnumWindows() calls;
1446 use IsWindow() to be sure.  All the functions in this group require (morphing to) PM.
1447
1448 =item C<$kid_hwnd = GetNextWindow($eh)>
1449
1450 gets the next kid in the list.  Gets 0 on error or when the list ends.
1451
1452 =item C<EndEnumWindows($eh)>
1453
1454 End enumeration and release the list.
1455
1456 =item C<@list = ChildWindows([$hwnd])>
1457
1458 returns the list of child windows at the moment of the call.  Same remark
1459 as for enumeration interface applies.  Defaults to HWND_DESKTOP.
1460 Example of usage:
1461
1462   sub l {
1463     my ($o,$h) = @_;
1464     printf ' ' x $o . "%#x\n", $h;
1465     l($o+2,$_) for ChildWindows $h;
1466   }
1467   l 0, $HWND_DESKTOP
1468
1469 =item C<IsWindow($hwnd)>
1470
1471 true if the window handle is still valid.
1472
1473 =item C<QueryWindow($hwnd, $type)>
1474
1475 gets the handle of a related window.  $type should be one of C<QW_*> constants.
1476
1477 =item C<IsChild($hwnd, $parent)>
1478
1479 return TRUE if $hwnd is a descendant of $parent.
1480
1481 =item C<WindowFromId($hwnd, $id)>
1482
1483 return a window handle of a child of $hwnd with the given $id.
1484
1485   hwndSysMenu = WinWindowFromID(hwndDlg, FID_SYSMENU);
1486   WinSendMsg(hwndSysMenu, MM_SETITEMATTR,
1487       MPFROM2SHORT(SC_CLOSE, TRUE),
1488       MPFROM2SHORT(MIA_DISABLED, MIA_DISABLED));
1489
1490 =item C<WindowFromPoint($x, $y [, $hwndParent [, $descedantsToo]])>
1491
1492 gets a handle of a child of $hwndParent at C<($x,$y)>.  If $descedantsToo
1493 (defaulting to 1) then children of children may be returned too.  May return
1494 $hwndParent (defaults to desktop) if no suitable children are found,
1495 or 0 if the point is outside the parent.
1496
1497 $x and $y are relative to $hwndParent.
1498
1499 =item C<EnumDlgItem($dlgHwnd, $type [, $relativeHwnd])>
1500
1501 gets a dialog item window handle for an item of type $type of $dlgHwnd
1502 relative to $relativeHwnd, which is descendant of $dlgHwnd.
1503 $relativeHwnd may be specified if $type is EDI_FIRSTTABITEM or
1504 EDI_LASTTABITEM.
1505
1506 The return is always an immediate child of hwndDlg, even if hwnd is
1507 not an immediate child window.  $type may be
1508
1509 =over
1510
1511 =item EDI_FIRSTGROUPITEM
1512
1513 First item in the same group.
1514
1515 =item EDI_FIRSTTABITEM
1516
1517 First item in dialog with style WS_TABSTOP. hwnd is ignored.
1518
1519 =item EDI_LASTGROUPITEM
1520
1521 Last item in the same group.
1522
1523 =item EDI_LASTTABITEM
1524
1525 Last item in dialog with style WS_TABSTOP. hwnd is ignored.
1526
1527 =item EDI_NEXTGROUPITEM
1528
1529 Next item in the same group. Wraps around to beginning of group when
1530 the end of the group is reached.
1531
1532 =item EDI_NEXTTABITEM
1533
1534 Next item with style WS_TABSTOP. Wraps around to beginning of dialog
1535 item list when end is reached.
1536
1537 =item EDI_PREVGROUPITEM
1538
1539 Previous item in the same group. Wraps around to end of group when the
1540 start of the group is reached. For information on the WS_GROUP style,
1541 see Window Styles.
1542
1543 =item EDI_PREVTABITEM
1544
1545 Previous item with style WS_TABSTOP. Wraps around to end of dialog
1546 item list when beginning is reached.
1547
1548 =back
1549
1550 =item DesktopWindow()
1551
1552 gets the actual window handle of the PM desktop; most APIs accept the
1553 pseudo-handle C<HWND_DESKTOP> instead.  Keep in mind that the WPS
1554 desktop (one with WindowText() being C<"Desktop">) is a different beast?!
1555
1556 =item TopLevel($hwnd)
1557
1558 gets the toplevel window of $hwnd.
1559
1560 =item ResetWinError()
1561
1562 Resets $^E.  One may need to call it before the C<Win*>-class APIs which may
1563 return 0 during normal operation.  In such a case one should check both
1564 for return value being zero and $^E being non-zero.  The following APIs
1565 do ResetWinError() themselves, thus do not need an explicit one:
1566
1567   WindowPtr
1568   WindowULong
1569   WindowUShort
1570   WindowTextLength
1571   ActiveWindow
1572   PostMsg
1573
1574 This function is normally not needed.  Not exported by default.
1575
1576 =back
1577
1578 =head2 Control of the PM data
1579
1580 =over
1581
1582 =item ActiveDesktopPathname()
1583
1584 gets the path of the directory which corresponds to Desktop.
1585
1586 =item   InvalidateRect
1587
1588 =item   CreateFrameControls
1589
1590 =back
1591
1592 =head2 Control of the PM clipboard
1593
1594 =over
1595
1596 =item ClipbrdText()
1597
1598 gets the content of the clipboard.  An optional argument is the format
1599 of the data in the clipboard (defaults to C<CF_TEXT>).  May croak with error
1600 C<PMERR_INVALID_HWND> if no data of given $fmt is present.
1601
1602 Note that the usual convention is to have clipboard data with
1603 C<"\r\n"> as line separators.  This function will only work with clipboard
1604 data types which are delimited by C<"\0"> byte (not included in the result).
1605
1606 =item ClipbrdText_2byte
1607
1608 Same as ClipbrdText(), but will only work with clipboard
1609 data types which are collection of C C<shorts> delimited by C<0> short
1610 (not included in the result).
1611
1612 =item ClipbrdTextUCS2le
1613
1614 Same as ClipbrdText_2byte(), but will assume that the shorts represent
1615 an Unicode string in I<UCS-2le> format (little-endian 2-byte representation
1616 of Unicode), and will provide the result in Perl internal C<utf8> format
1617 (one short of input represents one Perl character).
1618
1619 Note that Firefox etc. export their selection in unicode types of this format.
1620
1621 =item ClipbrdText_set($txt, [$no_convert_nl, [$fmt, [$fmtinfo, [$hab] ] ] ] )
1622
1623 sets the text content of the clipboard after removing old contents.  Unless the
1624 optional argument  $no_convert_nl is TRUE, will convert newlines to C<"\r\n">.  Another optional
1625 argument $fmt is the format of the data in the clipboard (should be an
1626 atom, defaults to C<CF_TEXT>).  Other arguments are as for C<ClipbrdData_set>.
1627 Croaks on failure.
1628
1629 =item   ClipbrdFmtInfo( [$fmt, [ $hab ] ])
1630
1631 returns the $fmtInfo flags set by the application which filled the
1632 format $fmt of the clipboard.  $fmt defaults to C<CF_TEXT>.
1633
1634 =item   ClipbrdOwner( [ $hab ] )
1635
1636 Returns window handle of the current clipboard owner.
1637
1638 =item   ClipbrdViewer( [ $hab ] )
1639
1640 Returns window handle of the current clipboard viewer.
1641
1642 =item   ClipbrdData( [$fmt, [ $hab ] ])
1643
1644 Returns a handle to clipboard data of the given format as an integer.
1645 Format defaults to C<CF_TEXT> (in this case the handle is a memory address).
1646
1647 Clipboard should be opened before calling this function.  May croak with error
1648 C<PMERR_INVALID_HWND> if no data of given $fmt is present.
1649
1650 The result should not be used after clipboard is closed.  Hence a return handle
1651 of type C<CLI_POINTER> may need to be converted to a string and stored for
1652 future usage.  Use MemoryRegionSize() to get a high estimate on the length
1653 of region addressed by this pointer; the actual length inside this region
1654 should be obtained by knowing particular format of data.  E.g., it may be
1655 0-byte terminated for string types, or 0-short terminated for wide-char string
1656 types.
1657
1658 =item   OpenClipbrd( [ $hab ] )
1659
1660 claim read access to the clipboard.  May need a message queue to operate.
1661 May block until other processes finish dealing with clipboard.
1662
1663 =item   CloseClipbrd( [ $hab ] )
1664
1665 Allow other processes access to clipboard.
1666 Clipboard should be opened before calling this function.
1667
1668 =item   ClipbrdData_set($data, [$convert_nl, [$fmt, [$fmtInfo, [ $hab] ] ] ] )
1669
1670 Sets the clipboard data of format given by atom $fmt.  Format defaults to
1671 CF_TEXT.
1672
1673 $fmtInfo should declare what type of handle $data is; it should be either
1674 C<CFI_POINTER>, or C<CFI_HANDLE> (possibly qualified by C<CFI_OWNERFREE>
1675 and C<CFI_OWNERDRAW> flags).  It defaults to C<CFI_HANDLE> for $fmt being
1676 standard bitmap, metafile, and palette (undocumented???) formats;
1677 otherwise defaults to C<CFI_POINTER>.  If format is C<CFI_POINTER>, $data
1678 should contain the string to copy to clipboard; otherwise it should be an
1679 integer handle.
1680
1681 If $convert_nl is TRUE (the default), C<"\n"> in $data are converted to
1682 C<"\r\n"> pairs if $fmt is C<CFI_POINTER> (as is the convention for text
1683 format of the clipboard) unless they are already in such a pair.
1684
1685 =item   _ClipbrdData_set($data, [$fmt, [$fmtInfo, [ $hab] ] ] )
1686
1687 Sets the clipboard data of format given by atom $fmt.  Format defaults to
1688 CF_TEXT.  $data should be an address (in givable unnamed shared memory which
1689 should not be accessed or manipulated after this call) or a handle in a form
1690 of an integer.
1691
1692 $fmtInfo has the same semantic as for ClipbrdData_set().
1693
1694 =item   ClipbrdOwner_set( $hwnd, [ $hab ] )
1695
1696 Sets window handle of the current clipboard owner (window which gets messages
1697 when content of clipboard is retrieved).
1698
1699 =item   ClipbrdViewer_set( $hwnd, [ $hab ] )
1700
1701 Sets window handle of the current clipboard owner (window which gets messages
1702 when content of clipboard is changed).
1703
1704 =item   ClipbrdFmtNames()
1705
1706 Returns list of names of formats currently available in the clipboard.
1707
1708 =item   ClipbrdFmtAtoms()
1709
1710 Returns list of atoms of formats currently available in the clipboard.
1711
1712 =item   EnumClipbrdFmts($fmt [, $hab])
1713
1714 Low-level access to the list of formats currently available in the clipboard.
1715 Returns the atom for the format of clipboard after $fmt.  If $fmt is 0, returns
1716 the first format of clipboard.  Returns 0 if $fmt is the last format.  Example:
1717
1718   {
1719     my $h = OS2::localClipbrd->new('nomorph');
1720     my $fmt = 0;
1721     push @formats, AtomName $fmt
1722       while $fmt = EnumClipbrdFmts $fmt;
1723   }
1724
1725 Clipboard should be opened before calling this function.  May croak if
1726 no format is present.
1727
1728 =item   EmptyClipbrd( [ $hab ] )
1729
1730 Remove all the data handles in the clipboard.  croak()s on failure.
1731 Clipboard should be opened before calling this function.
1732
1733 Recommended before assigning a value to clipboard to remove extraneous
1734 formats of data from clipboard.
1735
1736 =item ($size, $flags) = MemoryRegionSize($addr, [$size_lim, [ $interrupt ]])
1737
1738 $addr should be a memory address (encoded as integer).  This call finds
1739 the largest continuous region of memory belonging to the same memory object
1740 as $addr, and having the same memory flags as $addr. $flags is the value of
1741 the memory flag of $addr (see docs of DosQueryMem(3) for details).  If
1742 optional argument $size_lim is given, the search is restricted to the region
1743 this many bytes long (after $addr).
1744
1745 ($addr and $size are rounded so that all the memory pages containing
1746 the region are inspected.)  Optional argument $interrupt (defaults to 1)
1747 specifies whether region scan should be interruptible by signals.
1748
1749 =back
1750
1751 Use class C<OS2::localClipbrd> to ensure that clipboard is closed even if
1752 the code in the block made a non-local exit.
1753
1754 See the L</OS2::localMorphPM, OS2::localFlashWindow, and OS2::localClipbrd classes>
1755
1756 =head2 Control of the PM atom tables
1757
1758 Low-level methods to access the atom table(s).  $atomtable defaults to
1759 the SystemAtomTable().
1760
1761 =over
1762
1763 =item   AddAtom($name, [$atomtable])
1764
1765 Returns the atom; increments the use count unless $name is a name of an
1766 integer atom.
1767
1768 =item   FindAtom($name, [$atomtable])
1769
1770 Returns the atom if it exists, 0 otherwise (actually, croaks).
1771
1772 =item   DeleteAtom($name, [$atomtable])
1773
1774 Decrements the use count unless $name is a name of an integer atom.
1775 When count goes to 0, association of the name to an integer is removed.
1776 (Version with prepended underscore returns 0 on success.)
1777
1778 =item   AtomName($atom, [$atomtable])
1779
1780 Returns the name of the atom.  Integer atoms have names of format C<"#ddddd">
1781 of variable length up to 7 chars.
1782
1783 =item   AtomLength($atom, [$atomtable])
1784
1785 Returns the length of the name of the atom.  Return of 0 means that no
1786 such atom exists (but usually croaks in such a case).
1787
1788 Integer atoms always return length 6.
1789
1790 =item   AtomUsage($name, [$atomtable])
1791
1792 Returns the usage count of the atom.
1793
1794 =item   SystemAtomTable()
1795
1796 Returns central atom table accessible to any process.
1797
1798 =item   CreateAtomTable( [ $initial, [ $buckets ] ] )
1799
1800 Returns new per-process atom table.  See docs for WinCreateAtomTable(3).
1801
1802 =item   DestroyAtomTable($atomtable)
1803
1804 Dispose of the table. (Version with prepended underscore returns 0 on success.)
1805
1806
1807 =back
1808
1809 =head2 Alerting the user
1810
1811 =over
1812
1813 =item Alarm([$type])
1814
1815 Audible alarm of type $type (defaults to C<WA_ERROR=2>).  Other useful
1816 values are C<WA_WARNING=0>, C<WA_NOTE=1>.  (What is C<WA_CDEFALARMS=3>???)
1817
1818 The duration and frequency of the alarms can be changed by the
1819 OS2::SysValues_set(). The alarm frequency is defined to be in the range 0x0025
1820 through 0x7FFF. The alarm is not generated if system value SV_ALARM is set
1821 to FALSE. The alarms are dependent on the device capability.
1822
1823 =item FlashWindow($hwnd, $doFlash)
1824
1825 Starts/stops (depending on $doFlash being TRUE/FALSE) flashing the window
1826 $hwnd's borders and titlebar.  First 5 flashes are accompanied by alarm beeps.
1827
1828 Example (for VIO applications):
1829
1830   { my $morph = OS2::localMorphPM->new(0);
1831     print STDERR "Press ENTER!\n";
1832     FlashWindow(process_hwnd, 1);
1833     <>;
1834     FlashWindow(process_hwnd, 0);
1835   }
1836
1837 Since flashing window persists even when application ends, it is very
1838 important to protect the switching off flashing from non-local exits.  Use
1839 the class C<OS2::localFlashWindow> for this.  Creating the object of this
1840 class starts flashing the window until the object is destroyed.  The above
1841 example becomes:
1842
1843   print STDERR "Press ENTER!\n";
1844   { my $flash = OS2::localFlashWindow->new( process_hwnd );
1845     <>;
1846   }
1847
1848 B<Notes from IBM docs:> Flashing a window brings the user's attention to a
1849 window that is not the active window, where some important message or dialog
1850 must be seen by the user.
1851
1852 Note:  It should be used only for important messages, for example, where some
1853 component of the system is failing and requires immediate attention to avoid
1854 damage.
1855
1856 =item MessageBox($text, [ $title, [$flags, ...] ])
1857
1858 Shows a simple messagebox with (optional) icon, message $text, and one or
1859 more buttons to dismiss the box.  Returns the indicator of which action was
1860 taken by the user.  If optional argument $title is not given,
1861 the title is constructed from the application name.  The optional argument
1862 $flags describes the appearance of the box; the default is to have B<Cancel>
1863 button, I<INFO>-style icon, and a border for moving.  Flags should be
1864 a combination of
1865
1866  Buttons on the box: or Button Group
1867      MB_OK                 OK
1868      MB_OKCANCEL           both OK and CANCEL
1869      MB_CANCEL             CANCEL
1870      MB_ENTER              ENTER
1871      MB_ENTERCANCEL        both ENTER and CANCEL
1872      MB_RETRYCANCEL        both RETRY and CANCEL
1873      MB_ABORTRETRYIGNORE   ABORT, RETRY, and IGNORE
1874      MB_YESNO              both YES and NO
1875      MB_YESNOCANCEL        YES, NO, and CANCEL
1876
1877  Color or Icon
1878      MB_ICONHAND           a small red circle with a red line across
1879                            it.
1880      MB_ERROR              a small red circle with a red line across
1881                            it.
1882      MB_ICONASTERISK       an information (i) icon.
1883      MB_INFORMATION        an information (i) icon.
1884      MB_ICONEXCLAMATION    an exclamation point (!) icon.
1885      MB_WARNING            an exclamation point (!) icon.
1886      MB_ICONQUESTION       a question mark (?) icon.
1887      MB_QUERY              a question mark (?) icon.
1888      MB_NOICON             No icon.
1889
1890  Default action (i.e., focussed button; default is MB_DEFBUTTON1)
1891      MB_DEFBUTTON1         The first button is the default
1892                            selection.
1893      MB_DEFBUTTON2         The second button is the default
1894                            selection.
1895      MB_DEFBUTTON3         The third button is the default
1896                            selection.
1897
1898  Modality indicator
1899      MB_APPLMODAL                  Message box is application modal
1900                                    (default).
1901      MB_SYSTEMMODAL                Message box is system modal.
1902
1903  Mobility indicator
1904      MB_MOVEABLE                   Message box is moveable.
1905
1906 With C<MB_MOVEABLE> the message box is displayed with a title bar and a
1907 system menu, which shows only the Move, Close, and Task Manager choices,
1908 which can be selected either by use of the pointing device or by
1909 accelerator keys.  If the user selects Close, the message box is removed
1910 and the usResponse is set to C<MBID_CANCEL>, whether or not a cancel button
1911 existed within the message box.
1912
1913 C<Esc> key dismisses the dialogue only if C<CANCEL> button is present; the
1914 return value is C<MBID_CANCEL>.
1915
1916 With C<MB_APPLMODAL> the owner of the dialogue is disabled; therefore, do not
1917 specify the owner as the parent if this option is used.
1918
1919 Additionally, the following flag is possible, but probably not very useful:
1920
1921  Help button
1922      MB_HELP            a HELP button appears, which sends a WM_HELP
1923                         message is sent to the window procedure of
1924                         the message box.
1925
1926 Other optional arguments: $parent window, $owner_window, $helpID (used with
1927 C<WM_HELP> message if C<MB_HELP> style is given).
1928
1929 The return value is one of
1930
1931   MBID_ENTER           ENTER was selected
1932   MBID_OK              OK was selected
1933   MBID_CANCEL          CANCEL was selected
1934   MBID_ABORT           ABORT was selected
1935   MBID_RETRY           RETRY was selected
1936   MBID_IGNORE          IGNORE was selected
1937   MBID_YES             YES was selected
1938   MBID_NO              NO was selected
1939
1940   0                    Function not successful; an error occurred.
1941
1942 B<BUGS???> keyboard transversal by pressing C<TAB> key does not work.
1943 Do not appear in window list, so may be hard to find if covered by other
1944 windows.
1945
1946 =item _MessageBox($text, [ $title, [$flags, ...] ])
1947
1948 Similar to MessageBox(), but the default $title does not depend on the name
1949 of the script.
1950
1951 =item MessageBox2($text, [ $buttons_Icon, [$title, ...] ])
1952
1953 Similar to MessageBox(), but allows more flexible choice of button texts
1954 and the icon. $buttons_Icon is a reference to an array with information about
1955 buttons and the icon to use; the semantic of this array is the same as
1956 for argument list of process_MB2_INFO().  The default value will show
1957 one button B<Dismiss> which will return C<0x1000>.
1958
1959 Other optional arguments are the same as for MessageBox().
1960
1961 B<NOTE.> Remark about C<MBID_CANCEL> in presence of C<MB_MOVABLE> is
1962 equally applicable to MessageBox() and MessageBox2().
1963
1964 Example:
1965
1966   print MessageBox2
1967     'Foo prints 100, Bar 101, Baz 102',
1968     [['~Foo' => 100, 'B~ar' => 101, ['Ba~z'] => 102]],
1969     'Choose a number to print';
1970
1971 will show a messagebox with
1972
1973 =over 20
1974
1975 =item Title
1976
1977 B<Choose a number to print>,
1978
1979 =item Text
1980
1981 B<Foo prints 100, Bar 101, Baz 102>
1982
1983 =item Icon
1984
1985 INFORMATION ICON
1986
1987 =item Buttons
1988
1989 B<Foo>, B<Bar>, B<Baz>
1990
1991 =item Default button
1992
1993 B<Baz>
1994
1995 =item accelerator keys
1996
1997 B<F>, B<a>, and B<z>
1998
1999 =item return values
2000
2001 100, 101, and 102 correspondingly,
2002
2003 =back
2004
2005 Using
2006
2007   print MessageBox2
2008     'Foo prints 100, Bar 101, Baz 102',
2009     [['~Foo' => 100, 'B~ar' => 101, ['Ba~z'] => 102], 'SP#22'],
2010     'Choose a number to print';
2011
2012 will show the 22nd system icon as the dialog icon (small folder icon).
2013
2014 =item _MessageBox2($text, $buttons_Icon_struct, [$title, ...])
2015
2016 low-level workhorse to implement MessageBox2().  Differs by the default
2017 $title, and that $buttons_Icon_struct is required, and is a string with
2018 low-level C struct.
2019
2020 =item process_MB2_INFO($buttons, [$iconID, [$flags, [$notifyWindow]]])
2021
2022 low-level workhorse to implement MessageBox2(); calculates the second
2023 argument of _MessageBox2().  $buttons is a reference
2024 to array of button descriptions.  $iconID is either an ID of icon for
2025 the message box, or a string of the form C<"SP#number">; in the latter case
2026 the number's system icon is chosen; this field is ignored unless
2027 $flags contains C<MB_CUSTOMICON> flag.  $flags has the same meaning as mobility,
2028 modality, and icon flags for MessageBox() with addition of extra flags
2029
2030      MB_CUSTOMICON         Use a custom icon specified in hIcon.
2031      MB_NONMODAL           Message box is nonmodal
2032
2033 $flags defaults to C<MB_INFORMATION> or C<MB_CUSTOMICON> (depending on whether
2034 $iconID is non-0), combined with MB_MOVABLE.
2035
2036 Each button's description takes two elements of the description array,
2037 appearance description, and the return value of MessageBox2() if this
2038 button is selected.  The appearance description is either an array reference
2039 of the form C<[$button_Text, $button_Style]>, or the same without
2040 $button_Style (then style is C<BS_DEFAULT>, making this button the default)
2041 or just $button_Text (with "normal" style).  E.g., the list
2042
2043   Foo => 100, Bar => 101, [Baz] => 102
2044
2045 will show three buttons B<Foo>, B<Bar>, B<Baz> with B<Baz> being the default
2046 button; pressing buttons return 100, 101, or 102 correspondingly.
2047
2048 In particular, exactly one button should have C<BS_DEFAULT> style (e.g.,
2049 given as C<[$button_Name]>); otherwise the message box will not have keyboard
2050 focus!  (The only exception is the case of one button; then C<[$button_Name]>
2051 can be replaced (for convenience) with plain C<$button_Name>.)
2052
2053 If text of the button contains character C<~>, the following character becomes
2054 the keyboard accelerator for this button.  One can also get the handle
2055 of system icons directly, so C<'SP#22'> can be replaced by
2056 C<OS2::Process::get_pointer(22)>; see also C<SPTR_*> constants.
2057
2058 B<NOTE> With C<MB_NONMODAL> the program continues after displaying the
2059 nonmodal message box.  The message box remains visible until the owner window
2060 destroys it. Two notification messages, WM_MSGBOXINIT and WM_MSGBOXDISMISS,
2061 are used to support this non-modality.
2062
2063 =item LoadPointer($id, [$module, [$hwnd]])
2064
2065 Loads a handle for the pointer $id from the resources of the module
2066 $module on desktop $hwnd.  If $module is 0 (default), loads from the main
2067 executable; otherwise from a DLL with the handle $module.
2068
2069 The pointer is owned by the process, and is destroyed by
2070 DestroyPointer() call, or when the process terminates.
2071
2072 =item SysPointer($id, [$copy, [$hwnd]])
2073
2074 Gets a handle for (a copy of) the system pointer $id (the value should
2075 be one of C<SPTR_*> constants).  A copy is made if $copy is TRUE (the
2076 default).  $hwnd defaults to C<HWND_DESKTOP>.
2077
2078 =item get_pointer($id, [$copy, [$hwnd]])
2079
2080 Gets (and caches) a copy of the system pointer.
2081
2082 =back
2083
2084 =head2 Constants used by OS/2 APIs
2085
2086 Function C<os2constant($name)> returns the value of the constant; to
2087 decrease the memory usage of this package, only the constants used by
2088 APIs called by Perl functions in this package are made available.
2089
2090 For direct access, see also the L<"EXPORTS"> section; the latter way
2091 may also provide some performance advantages, since the value of the
2092 constant is cached.
2093
2094 =head1 OS2::localMorphPM, OS2::localFlashWindow, and OS2::localClipbrd classes
2095
2096 The class C<OS2::localMorphPM> morphs the process to PM for the duration of
2097 the given scope.
2098
2099   {
2100     my $h = OS2::localMorphPM->new(0);
2101     # Do something
2102   }
2103
2104 The argument has the same meaning as one to OS2::MorphPM().  Calls can
2105 nest with internal ones being NOPs.
2106
2107 Likewise, C<OS2::localClipbrd> class opens the clipboard for the duration
2108 of the current scope; if TRUE optional argument is given, it would not
2109 morph the application into PM:
2110
2111   {
2112     my $handle = OS2::localClipbrd->new(1);     # Do not morph into PM
2113     # Do something with clipboard here...
2114   }
2115
2116 C<OS2::localFlashWindow> behaves similarly; see
2117 L<FlashWindow($hwnd, $doFlash)>.
2118
2119 =head1 EXAMPLES
2120
2121 The test suite for this module contains an almost comprehensive collection
2122 of examples of using the API of this module.
2123
2124 =head1 TODO
2125
2126 Add tests for:
2127
2128         SwitchToProgram
2129         ClassName
2130         out_codepage
2131         out_codepage_set
2132         in_codepage
2133         in_codepage_set
2134         cursor
2135         cursor_set
2136         screen
2137         screen_set
2138         process_codepages
2139         QueryWindow
2140         EnumDlgItem
2141         WindowPtr
2142         WindowUShort
2143         SetWindowBits
2144         SetWindowPtr
2145         SetWindowULong
2146         SetWindowUShort
2147         my_type
2148         file_type
2149         scrsize
2150         scrsize_set
2151
2152 Document: InvalidateRect,
2153 CreateFrameControls, kbdChar, kbdhChar,
2154 kbdStatus, _kbdStatus_set, kbdhStatus, kbdhStatus_set,
2155 vioConfig, viohConfig, vioMode, viohMode, viohMode_set, _vioMode_set,
2156 _vioState, _vioState_set, vioFont, vioFont_set
2157
2158 Test: SetWindowULong/Short/Ptr, SetWindowBits. InvalidateRect,
2159 CreateFrameControls, ClipbrdOwner_set, ClipbrdViewer_set, _ClipbrdData_set,
2160 Alarm, FlashWindow, _MessageBox, MessageBox, _MessageBox2, MessageBox2,
2161 LoadPointer, SysPointer, kbdChar, kbdhChar, kbdStatus, _kbdStatus_set,
2162 kbdhStatus,  kbdhStatus_set, vioConfig, viohConfig, vioMode, viohMode,
2163 viohMode_set, _vioMode_set, _vioState, _vioState_set, vioFont, vioFont_set
2164
2165 Implement SOMETHINGFROMMR.
2166
2167
2168   >But I wish to change the default button if the user enters some
2169   >text into an entryfield.  I can detect the entry ok, but can't
2170   >seem to get the button to change to default.
2171   >
2172   >No matter what message I send it, it's being ignored.
2173
2174   You need to get the style of the buttons using
2175   WinQueryWindowULong/QWL_STYLE, set and reset the BS_DEFAULT bits as
2176   appropriate and then use WinSetWindowULong/QWL_STYLE to set the
2177   button style.  Something like this:
2178     hwnd1 = WinWindowFromID (hwnd, id1);
2179     hwnd2 = WinWindowFromID (hwnd, id2);
2180     style1 = WinQueryWindowULong (hwnd1, QWL_STYLE);
2181     style2 = WinQueryWindowULong (hwnd2, QWL_STYLE);
2182     style1 |= style2 & BS_DEFAULT;
2183     style2 &= ~BS_DEFAULT;
2184     WinSetWindowULong (hwnd1, QWL_STYLE, style1);
2185     WinSetWindowULong (hwnd2, QWL_STYLE, style2);
2186
2187  > How to do query and change a frame creation flags for existing
2188  > window?
2189
2190  Set the style bits that correspond to the FCF_* flag for the frame
2191  window and then send a WM_UPDATEFRAME message with the appropriate
2192  FCF_* flag in mp1.
2193
2194  ULONG ulFrameStyle;
2195  ulFrameStyle = WinQueryWindowULong( WinQueryWindow(hwnd, QW_PARENT),
2196  QWL_STYLE );
2197  ulFrameStyle = (ulFrameStyle & ~FS_SIZEBORDER) | FS_BORDER;
2198  WinSetWindowULong(   WinQueryWindow(hwnd, QW_PARENT),
2199                       QWL_STYLE,
2200                       ulFrameStyle );
2201  WinSendMsg( WinQueryWindow(hwnd, QW_PARENT),
2202              WM_UPDATEFRAME,
2203              MPFROMP(FCF_SIZEBORDER),
2204              MPVOID );
2205
2206  If the FCF_* flags you want to change does not have a corresponding
2207  FS_* style (i.e. the FCF_* flag corresponds to the presence/lack of a
2208  frame control rather than a property of the frame itself) then you
2209  create or destroy the appropriate control window using the correct
2210  FID_* window identifier and then send the WM_UPDATEFRAME message with
2211  the appropriate FCF_* flag in mp1.
2212
2213  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
2214   |  SetFrameBorder()                                                 |
2215   |    Changes a frame window's border to the requested type.         |
2216   |                                                                   |
2217   |  Parameters on entry:                                             |
2218   |    hwndFrame     -> Frame window whose border is to be changed.   |
2219   |    ulBorderStyle -> Type of border to change to.                  |
2220   |                                                                   |
2221   |  Returns:                                                         |
2222   |    BOOL          -> Success indicator.                            |
2223   |                                                                   |
2224   * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
2225  BOOL SetFrameBorder( HWND hwndFrame, ULONG ulBorderType )  {
2226    ULONG  ulFrameStyle;
2227    BOOL   fSuccess = TRUE;
2228
2229    ulFrameStyle = WinQueryWindowULong( hwndFrame, QWL_STYLE );
2230
2231    switch ( ulBorderType )  {
2232      case FS_SIZEBORDER :
2233        ulFrameStyle = (ulFrameStyle & ~(FS_DLGBORDER | FS_BORDER))
2234                       | FS_SIZEBORDER;
2235        break;
2236
2237      case FS_DLGBORDER :
2238        ulFrameStyle = (ulFrameStyle & ~(FS_SIZEBORDER | FS_BORDER))
2239                       | FS_DLGBORDER;
2240        break;
2241
2242      case FS_BORDER :
2243        ulFrameStyle = (ulFrameStyle & ~(FS_SIZEBORDER | FS_DLGBORDER))
2244                       | FS_BORDER;
2245        break;
2246
2247      default :
2248        fSuccess = FALSE;
2249        break;
2250    }  // end switch
2251
2252    if ( fSuccess )  {
2253      fSuccess = WinSetWindowULong( hwndFrame, QWL_STYLE, ulFrameStyle );
2254
2255      if ( fSuccess )  {
2256        fSuccess = (BOOL)WinSendMsg( hwndFrame, WM_UPDATEFRAME, 0, 0 );
2257        if ( fSuccess )
2258          fSuccess = WinInvalidateRect( hwndFrame, NULL, TRUE );
2259      }
2260    }
2261
2262    return ( fSuccess );
2263
2264  }  // End SetFrameBorder()
2265
2266          hwndMenu=WinLoadMenu(hwndParent,NULL,WND_IMAGE);
2267          WinSetWindowUShort(hwndMenu,QWS_ID,FID_MENU);
2268          ulStyle=WinQueryWindowULong(hwndMenu,QWL_STYLE);
2269          WinSetWindowULong(hwndMenu,QWL_STYLE,ulStyle|MS_ACTIONBAR);
2270          WinSendMsg(hwndParent,WM_UPDATEFRAME,MPFROMSHORT(FCF_MENU),0L);
2271
2272   OS/2-windows have another "parent" called the *owner*,
2273   which must be set separately - to get a close relationship:
2274
2275     WinSetOwner (hwndFrameChild, hwndFrameMain);
2276
2277   Now your child should move with your main window!
2278   And always stays on top of it....
2279
2280   To avoid this, for example for dialogwindows, you can
2281   also "disconnect" this relationship with:
2282
2283     WinSetWindowBits (hwndFrameChild, QWL_STYLE
2284                       , FS_NOMOVEWITHOWNER
2285                       , FS_NOMOVEWITHOWNER);
2286
2287  Adding a button icon later:
2288
2289  /* switch the button style to BS_MINIICON */
2290  WinSetWindowBits(hwndBtn, QWL_STYLE, BS_MINIICON, BS_MINIICON) ;
2291
2292  /* set up button control data */
2293  BTNCDATA    bcd;
2294  bcd.cb = sizeof(BTNCDATA);
2295  bcd.hImage = WinLoadPointer(HWND_DESKTOP, dllHandle, ID_ICON_BUTTON1) ;
2296  bcd.fsCheckState = bcd.fsHiliteState = 0 ;
2297
2298
2299  WNDPARAMS   wp;
2300  wp.fsStatus = WPM_CTLDATA;
2301  wp.pCtlData = &bcd;
2302
2303  /* add the icon on the button */
2304  WinSendMsg(hwndBtn, WM_SETWINDOWPARAMS, (MPARAM)&wp, NULL);
2305
2306  MO> Can anyone tell what OS/2 expects of an application to be properly
2307  MO> minimized to the desktop?
2308  case WM MINMAXFRAME :
2309  {
2310    BOOL  fShow = ! (((PSWP) mp1)->fl & SWP MINIMIZE);
2311    HENUM henum;
2312
2313    HWND  hwndChild;
2314
2315    WinEnableWindowUpdate ( hwnd, FALSE );
2316
2317    for (henum=WinBeginEnumWindows(hwnd);
2318         (hwndChild = WinGetNextWindow (henum)) != 0; )
2319    WinShowWindow ( hwndChild, fShow );
2320
2321    WinEndEnumWindows ( henum );
2322    WinEnableWindowUpdate ( hwnd, TRUE );
2323  }
2324  break;
2325
2326 Why C<hWindowPos DesktopWindow> gives C<< behind => HWND_TOP >>?
2327
2328 =head1 $^E
2329
2330 the majority of the APIs of this module set $^E on failure (no matter
2331 whether they die() on failure or not).  By the semantic of PM API
2332 which returns something other than a boolean, it is impossible to
2333 distinguish failure from a "normal" 0-return.  In such cases C<$^E ==
2334 0> indicates an absence of error.
2335
2336 =head1 EXPORTS
2337
2338 In addition to symbols described above, the following constants (available
2339 also via module C<OS2::Process::Const>) are exportable.  Note that these
2340 symbols live in package C<OS2::Process::Const>, they are not available
2341 by full name through C<OS2::Process>!
2342
2343   HWND_*                Standard (abstract) window handles
2344   WM_*                  Message ids
2345   SC_*                  WM_SYSCOMMAND flavor
2346   SWP_*                 Size/move etc flag
2347   WC_*                  Standard window classes
2348   PROG_*                Program category (PM, VIO etc)
2349   QW_*                  Query-Window flag
2350   EDI_*                 Enumerate-Dialog-Item code
2351   WS_*                  Window Style flag
2352   QWS_*                 Query-window-UShort offsets
2353   QWP_*                 Query-window-pointer offsets
2354   QWL_*                 Query-window-ULong offsets
2355   FF_*                  Frame-window state flags
2356   FI_*                  Frame-window information flags
2357   LS_*                  List box styles
2358   FS_*                  Frame style
2359   FCF_*                 Frame creation flags
2360   BS_*                  Button style
2361   MS_*                  Menu style
2362   TBM_*                 Title bar messages?
2363   CF_*                  Clipboard formats
2364   CFI_*                 Clipboard storage type
2365   FID_*                 ids of subwindows of frames
2366
2367 =head1 BUGS
2368
2369 whether a given API dies or returns FALSE/empty-list on error may be
2370 confusing.  This may change in the future.
2371
2372 =head1 AUTHOR
2373
2374 Andreas Kaiser <ak@ananke.s.bawue.de>,
2375 Ilya Zakharevich <ilya@math.ohio-state.edu>.
2376
2377 =head1 SEE ALSO
2378
2379 C<spawn*>() system calls, L<OS2::Proc> and L<OS2::WinObject> modules.
2380
2381 =cut