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.02";
  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 "Unconsistent 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 L<OS2::localMorphPM class>.
1229
1230 Keep in mind that PM windows are engaged in 2 "orthogonal" window
1231 trees, as well as in the z-order list.
1232
1233 One tree is given by the I<parent/child> relationship.  This
1234 relationship affects drawing (child is drawn relative to its parent
1235 (lower-left corner), and the drawing is clipped by the parent's
1236 boundary; parent may request that I<it's> drawing is clipped to be
1237 confined to the outsize of the childs and/or siblings' windows);
1238 hiding; minimizing/restoring; and destroying windows.
1239
1240 Another tree (not necessarily connected?) is given by I<ownership>
1241 relationship.  Ownership relationship assumes cooperation of the
1242 engaged windows via passing messages on "important events"; e.g.,
1243 scrollbars send information messages when the "bar" is moved, menus
1244 send messages when an item is selected; frames
1245 move/hide/unhide/minimize/restore/change-z-order-of owned frames when
1246 the owner is moved/etc., and destroy the owned frames (even when these
1247 frames are not descendants) when the owner is destroyed; etc.  [An
1248 important restriction on ownership is that owner should be created by
1249 the same thread as the owned thread, so they engage in the same
1250 message queue.]
1251
1252 Windows may be in many different state: Focused (take keyboard events) or not,
1253 Activated (=Frame windows in the I<parent/child> tree between the root and
1254 the window with the focus; usually indicate such "active state" by titlebar
1255 highlights, and take mouse events) or not, Enabled/Disabled (this influences
1256 the ability to update the graphic, and may change appearance, as for
1257 enabled/disabled buttons), Visible/Hidden, Minimized/Maximized/Restored, Modal
1258 or not, etc.
1259
1260 The APIs below all die() on error with the message being $^E.
1261
1262 =over
1263
1264 =item C<WindowText($hwnd)>
1265
1266 gets "a text content" of a window.  Requires (morphing to) PM.
1267
1268 =item C<WindowText_set($hwnd, $text)>
1269
1270 sets "a text content" of a window.  Requires (morphing to) PM.
1271
1272 =item C<($x, $y, $flags, $width, $height, $behind, @rest) = WindowPos($hwnd)>
1273
1274 gets window position info as 8 integers (of C<SWP>), in the order suitable
1275 for WindowPos_set().  @rest is marked as "reserved" in PM docs.  $flags
1276 is a combination of C<SWP_*> constants.
1277
1278 =item C<$hash = hWindowPos($hwnd)>
1279
1280 gets window position info as a hash reference; the keys are C<flags width
1281 height x y behind hwnd reserved1 reserved2>.
1282
1283 Example:
1284
1285   exit unless $hash->{flags} & SWP_MAXIMIZE;    # Maximized
1286
1287 =item C<WindowPos_set($hwnd, $x, $y, $flags = SWP_MOVE, $width = 0, $height = 0, $behind = HWND_TOP)>
1288
1289 Set state of the window: position, size, zorder, show/hide, activation,
1290 minimize/maximize/restore etc.  Which of these operations to perform
1291 is governed by $flags.
1292
1293 =item C<hWindowPos_set($hash, [$hwnd])>
1294
1295 Same as C<WindowPos_set>, but takes the position from keys C<fl width height
1296 x y behind hwnd> of the hash referenced by $hash.  If $hwnd is explicitly
1297 specified, it overrides C<$hash->{hwnd}>.  If $hash->{flags} is not specified,
1298 it is calculated basing on the existing keys of $hash.  Requires (morphing to) PM.
1299
1300 Example:
1301
1302   hWindowPos_set {flags => SWP_MAXIMIZE}, $hwnd; # Maximize
1303
1304 =item C<($pid, $tid) = WindowProcess($hwnd)>
1305
1306 gets I<PID> and I<TID> of the process associated to the window.
1307
1308 =item C<ClassName($hwnd)>
1309
1310 returns the class name of the window.
1311
1312 If this window is of any of the preregistered WC_* classes the class
1313 name returned is in the form "#nnnnn", where "nnnnn" is a group
1314 of up to five digits that corresponds to the value of the WC_* class name
1315 constant.
1316
1317 =item WindowStyle($hwnd)
1318
1319 Returns the "window style" flags for window handle $hwnd.
1320
1321 =item WindowULong($hwnd, $id), WindowPtr($hwnd, $id), WindowUShort($hwnd, $id)
1322
1323 Return data associated to window handle $hwnd.  $id should be one of
1324 C<QWL_*>, C<QWP_PFNWP>, C<QWS_*> constants, or a byte offset referencing
1325 a region (of length 4, 4, 2 correspondingly) fully inside C<0..cbWindowData-1>.
1326 Here C<cbWindowData> is the count of extra user-specified bytes reserved
1327 for the given class of windows.
1328
1329 =item WindowULong_set($hwnd, $id, $value), WindowPtr_set, WindowUShort_set
1330
1331 Similar to WindowULong(), WindowPtr(), WindowUShort(), but for assigning the
1332 value $value.
1333
1334 =item WindowBits_set($hwnd, $id, $value, $mask)
1335
1336 Similar to WindowULong_set(), but will change only the bits which are
1337 set in $mask.
1338
1339 =item FocusWindow()
1340
1341 returns the handle of the focus window.  Optional argument for specifying
1342 the desktop to use.
1343
1344 =item C<FocusWindow_set($hwnd)>
1345
1346 set the focus window by handle.  Optional argument for specifying the desktop
1347 to use.  E.g, the first entry in program_entries() is the C<Ctrl-Esc> list.
1348 To show an application, use either one of
1349
1350        WinShowWindow( $hwnd, 1 );
1351        FocusWindow_set( $hwnd );
1352        SwitchToProgram($switch_handle);
1353
1354 (Which work with alternative focus-to-front policies?)  Requires
1355 (morphing to) PM.
1356
1357 Switching focus to currently-unfocused window moves the window to the
1358 front in Z-order; use FocusWindow_set_keep_Zorder() to avoid this.
1359
1360 =item C<FocusWindow_set_keep_Zorder($hwnd)>
1361
1362 same as FocusWindow_set(), but preserves the Z-order of windows.
1363
1364 =item C<ActiveWindow([$parentHwnd])>
1365
1366 gets the active subwindow's handle for $parentHwnd or desktop.
1367 Returns FALSE if none.
1368
1369 =item C<ActiveWindow_set($hwnd, [$parentHwnd])>
1370
1371 sets the active subwindow's handle for $parentHwnd or desktop.  Requires (morphing to) PM.
1372
1373 =item C<ShowWindow($hwnd [, $show])>
1374
1375 Set visible/hidden flag of the window.  Default: $show is TRUE.
1376
1377 =item C<EnableWindowUpdate($hwnd [, $update])>
1378
1379 Set window visibility state flag for the window for subsequent drawing.
1380 No actual drawing is done at this moment.  Use C<ShowWindow($hwnd, $state)>
1381 when redrawing is needed.  While update is disabled, changes to the "window
1382 state" do not change the appearance of the window.  Default: $update is TRUE.
1383
1384 (What is manipulated is the bit C<WS_VISIBLE> of the window style.)
1385
1386 =item C<EnableWindow($hwnd [, $enable])>
1387
1388 Set the window enabled state.  Default: $enable is TRUE.
1389
1390 Results in C<WM_ENABLED> message sent to the window.  Typically, this
1391 would change the appearence of the window.  If at the moment of disabling
1392 focus is in the window (or a descendant), focus is lost (no focus anywhere).
1393 If focus is needed, it can be reassigned explicitly later.
1394
1395 =item IsWindowEnabled(), IsWindowVisible(), IsWindowShowing()
1396
1397 these functions take $hwnd as an argument.  IsWindowEnabled() queries
1398 the state changed by EnableWindow(), IsWindowVisible() the state changed
1399 by ShowWindow(), IsWindowShowing() is true if there is a part of the window
1400 visible on the screen.
1401
1402 =item C<PostMsg($hwnd, $msg, $mp1, $mp2)>
1403
1404 post message to a window.  The meaning of $mp1, $mp2 is specific for each
1405 message id $msg, they default to 0.  E.g.,
1406
1407   use OS2::Process qw(:DEFAULT WM_SYSCOMMAND WM_CONTEXTMENU
1408                       WM_SAVEAPPLICATION WM_QUIT WM_CLOSE
1409                       SC_MAXIMIZE SC_RESTORE);
1410   $hwnd = process_hentry()->{owner_hwnd};
1411   # Emulate choosing `Restore' from the window menu:
1412   PostMsg $hwnd, WM_SYSCOMMAND, MPFROMSHORT(SC_RESTORE); # Not immediate
1413
1414   # Emulate `Show-Contextmenu' (Double-Click-2), two ways:
1415   PostMsg ActiveWindow, WM_CONTEXTMENU;
1416   PostMsg FocusWindow, WM_CONTEXTMENU;
1417
1418   /* Emulate `Close' */
1419   PostMsg ActiveWindow, WM_CLOSE;
1420
1421   /* Same but with some "warnings" to the application */
1422   $hwnd = ActiveWindow;
1423   PostMsg $hwnd, WM_SAVEAPPLICATION;
1424   PostMsg $hwnd, WM_CLOSE;
1425   PostMsg $hwnd, WM_QUIT;
1426
1427 In fact, MPFROMSHORT() may be omitted above.
1428
1429 For messages to other processes, messages which take/return a pointer are
1430 not supported.
1431
1432 =item C<MP*()>
1433
1434 The functions MPFROMSHORT(), MPVOID(), MPFROMCHAR(), MPFROM2SHORT(),
1435 MPFROMSH2CH(), MPFROMLONG() can be used the same way as from C.  Use them
1436 to construct parameters $m1, $m2 to PostMsg().
1437
1438 These functions are not exported by default.
1439
1440 =item C<$eh = BeginEnumWindows($hwnd)>
1441
1442 starts enumerating immediate child windows of $hwnd in z-order.  The
1443 enumeration reflects the state at the moment of BeginEnumWindows() calls;
1444 use IsWindow() to be sure.  All the functions in this group require (morphing to) PM.
1445
1446 =item C<$kid_hwnd = GetNextWindow($eh)>
1447
1448 gets the next kid in the list.  Gets 0 on error or when the list ends.
1449
1450 =item C<EndEnumWindows($eh)>
1451
1452 End enumeration and release the list.
1453
1454 =item C<@list = ChildWindows([$hwnd])>
1455
1456 returns the list of child windows at the moment of the call.  Same remark
1457 as for enumeration interface applies.  Defaults to HWND_DESKTOP.
1458 Example of usage:
1459
1460   sub l {
1461     my ($o,$h) = @_;
1462     printf ' ' x $o . "%#x\n", $h;
1463     l($o+2,$_) for ChildWindows $h;
1464   }
1465   l 0, $HWND_DESKTOP
1466
1467 =item C<IsWindow($hwnd)>
1468
1469 true if the window handle is still valid.
1470
1471 =item C<QueryWindow($hwnd, $type)>
1472
1473 gets the handle of a related window.  $type should be one of C<QW_*> constants.
1474
1475 =item C<IsChild($hwnd, $parent)>
1476
1477 return TRUE if $hwnd is a descendant of $parent.
1478
1479 =item C<WindowFromId($hwnd, $id)>
1480
1481 return a window handle of a child of $hwnd with the given $id.
1482
1483   hwndSysMenu = WinWindowFromID(hwndDlg, FID_SYSMENU);
1484   WinSendMsg(hwndSysMenu, MM_SETITEMATTR,
1485       MPFROM2SHORT(SC_CLOSE, TRUE),
1486       MPFROM2SHORT(MIA_DISABLED, MIA_DISABLED));
1487
1488 =item C<WindowFromPoint($x, $y [, $hwndParent [, $descedantsToo]])>
1489
1490 gets a handle of a child of $hwndParent at C<($x,$y)>.  If $descedantsToo
1491 (defaulting to 1) then children of children may be returned too.  May return
1492 $hwndParent (defaults to desktop) if no suitable children are found,
1493 or 0 if the point is outside the parent.
1494
1495 $x and $y are relative to $hwndParent.
1496
1497 =item C<EnumDlgItem($dlgHwnd, $type [, $relativeHwnd])>
1498
1499 gets a dialog item window handle for an item of type $type of $dlgHwnd
1500 relative to $relativeHwnd, which is descendant of $dlgHwnd.
1501 $relativeHwnd may be specified if $type is EDI_FIRSTTABITEM or
1502 EDI_LASTTABITEM.
1503
1504 The return is always an immediate child of hwndDlg, even if hwnd is
1505 not an immediate child window.  $type may be
1506
1507 =over
1508
1509 =item EDI_FIRSTGROUPITEM
1510
1511 First item in the same group.
1512
1513 =item EDI_FIRSTTABITEM
1514
1515 First item in dialog with style WS_TABSTOP. hwnd is ignored.
1516
1517 =item EDI_LASTGROUPITEM
1518
1519 Last item in the same group.
1520
1521 =item EDI_LASTTABITEM
1522
1523 Last item in dialog with style WS_TABSTOP. hwnd is ignored.
1524
1525 =item EDI_NEXTGROUPITEM
1526
1527 Next item in the same group. Wraps around to beginning of group when
1528 the end of the group is reached.
1529
1530 =item EDI_NEXTTABITEM
1531
1532 Next item with style WS_TABSTOP. Wraps around to beginning of dialog
1533 item list when end is reached.
1534
1535 =item EDI_PREVGROUPITEM
1536
1537 Previous item in the same group. Wraps around to end of group when the
1538 start of the group is reached. For information on the WS_GROUP style,
1539 see Window Styles.
1540
1541 =item EDI_PREVTABITEM
1542
1543 Previous item with style WS_TABSTOP. Wraps around to end of dialog
1544 item list when beginning is reached.
1545
1546 =back
1547
1548 =item DesktopWindow()
1549
1550 gets the actual window handle of the PM desktop; most APIs accept the
1551 pseudo-handle C<HWND_DESKTOP> instead.  Keep in mind that the WPS
1552 desktop (one with WindowText() being C<"Desktop">) is a different beast?!
1553
1554 =item TopLevel($hwnd)
1555
1556 gets the toplevel window of $hwnd.
1557
1558 =item ResetWinError()
1559
1560 Resets $^E.  One may need to call it before the C<Win*>-class APIs which may
1561 return 0 during normal operation.  In such a case one should check both
1562 for return value being zero and $^E being non-zero.  The following APIs
1563 do ResetWinError() themselves, thus do not need an explicit one:
1564
1565   WindowPtr
1566   WindowULong
1567   WindowUShort
1568   WindowTextLength
1569   ActiveWindow
1570   PostMsg
1571
1572 This function is normally not needed.  Not exported by default.
1573
1574 =back
1575
1576 =head2 Control of the PM data
1577
1578 =over
1579
1580 =item ActiveDesktopPathname()
1581
1582 gets the path of the directory which corresponds to Desktop.
1583
1584 =item   InvalidateRect
1585
1586 =item   CreateFrameControls
1587
1588 =back
1589
1590 =head2 Control of the PM clipboard
1591
1592 =over
1593
1594 =item ClipbrdText()
1595
1596 gets the content of the clipboard.  An optional argument is the format
1597 of the data in the clipboard (defaults to C<CF_TEXT>).  May croak with error
1598 C<PMERR_INVALID_HWND> if no data of given $fmt is present.
1599
1600 Note that the usual convention is to have clipboard data with
1601 C<"\r\n"> as line separators.  This function will only work with clipboard
1602 data types which are delimited by C<"\0"> byte (not included in the result).
1603
1604 =item ClipbrdText_2byte
1605
1606 Same as ClipbrdText(), but will only work with clipboard
1607 data types which are collection of C C<shorts> delimited by C<0> short
1608 (not included in the result).
1609
1610 =item ClipbrdTextUCS2le
1611
1612 Same as ClipbrdText_2byte(), but will assume that the shorts represent
1613 an Unicode string in I<UCS-2le> format (little-endian 2-byte representation
1614 of Unicode), and will provide the result in Perl internal C<utf8> format
1615 (one short of input represents one Perl character).
1616
1617 Note that Firefox etc. export their selection in unicode types of this format.
1618
1619 =item ClipbrdText_set($txt, [$no_convert_nl, [$fmt, [$fmtinfo, [$hab] ] ] ] )
1620
1621 sets the text content of the clipboard after removing old contents.  Unless the
1622 optional argument  $no_convert_nl is TRUE, will convert newlines to C<"\r\n">.  Another optional
1623 argument $fmt is the format of the data in the clipboard (should be an
1624 atom, defaults to C<CF_TEXT>).  Other arguments are as for C<ClipbrdData_set>.
1625 Croaks on failure.
1626
1627 =item   ClipbrdFmtInfo( [$fmt, [ $hab ] ])
1628
1629 returns the $fmtInfo flags set by the application which filled the
1630 format $fmt of the clipboard.  $fmt defaults to C<CF_TEXT>.
1631
1632 =item   ClipbrdOwner( [ $hab ] )
1633
1634 Returns window handle of the current clipboard owner.
1635
1636 =item   ClipbrdViewer( [ $hab ] )
1637
1638 Returns window handle of the current clipboard viewer.
1639
1640 =item   ClipbrdData( [$fmt, [ $hab ] ])
1641
1642 Returns a handle to clipboard data of the given format as an integer.
1643 Format defaults to C<CF_TEXT> (in this case the handle is a memory address).
1644
1645 Clipboard should be opened before calling this function.  May croak with error
1646 C<PMERR_INVALID_HWND> if no data of given $fmt is present.
1647
1648 The result should not be used after clipboard is closed.  Hence a return handle
1649 of type C<CLI_POINTER> may need to be converted to a string and stored for
1650 future usage.  Use MemoryRegionSize() to get a high estimate on the length
1651 of region addressed by this pointer; the actual length inside this region
1652 should be obtained by knowing particular format of data.  E.g., it may be
1653 0-byte terminated for string types, or 0-short terminated for wide-char string
1654 types.
1655
1656 =item   OpenClipbrd( [ $hab ] )
1657
1658 claim read access to the clipboard.  May need a message queue to operate.
1659 May block until other processes finish dealing with clipboard.
1660
1661 =item   CloseClipbrd( [ $hab ] )
1662
1663 Allow other processes access to clipboard.
1664 Clipboard should be opened before calling this function.
1665
1666 =item   ClipbrdData_set($data, [$convert_nl, [$fmt, [$fmtInfo, [ $hab] ] ] ] )
1667
1668 Sets the clipboard data of format given by atom $fmt.  Format defaults to
1669 CF_TEXT.
1670
1671 $fmtInfo should declare what type of handle $data is; it should be either
1672 C<CFI_POINTER>, or C<CFI_HANDLE> (possibly qualified by C<CFI_OWNERFREE>
1673 and C<CFI_OWNERDRAW> flags).  It defaults to C<CFI_HANDLE> for $fmt being
1674 standard bitmap, metafile, and palette (undocumented???) formats;
1675 otherwise defaults to C<CFI_POINTER>.  If format is C<CFI_POINTER>, $data
1676 should contain the string to copy to clipboard; otherwise it should be an
1677 integer handle.
1678
1679 If $convert_nl is TRUE (the default), C<"\n"> in $data are converted to
1680 C<"\r\n"> pairs if $fmt is C<CFI_POINTER> (as is the convention for text
1681 format of the clipboard) unless they are already in such a pair.
1682
1683 =item   _ClipbrdData_set($data, [$fmt, [$fmtInfo, [ $hab] ] ] )
1684
1685 Sets the clipboard data of format given by atom $fmt.  Format defaults to
1686 CF_TEXT.  $data should be an address (in givable unnamed shared memory which
1687 should not be accessed or manipulated after this call) or a handle in a form
1688 of an integer.
1689
1690 $fmtInfo has the same semantic as for ClipbrdData_set().
1691
1692 =item   ClipbrdOwner_set( $hwnd, [ $hab ] )
1693
1694 Sets window handle of the current clipboard owner (window which gets messages
1695 when content of clipboard is retrieved).
1696
1697 =item   ClipbrdViewer_set( $hwnd, [ $hab ] )
1698
1699 Sets window handle of the current clipboard owner (window which gets messages
1700 when content of clipboard is changed).
1701
1702 =item   ClipbrdFmtNames()
1703
1704 Returns list of names of formats currently available in the clipboard.
1705
1706 =item   ClipbrdFmtAtoms()
1707
1708 Returns list of atoms of formats currently available in the clipboard.
1709
1710 =item   EnumClipbrdFmts($fmt [, $hab])
1711
1712 Low-level access to the list of formats currently available in the clipboard.
1713 Returns the atom for the format of clipboard after $fmt.  If $fmt is 0, returns
1714 the first format of clipboard.  Returns 0 if $fmt is the last format.  Example:
1715
1716   {
1717     my $h = OS2::localClipbrd->new('nomorph');
1718     my $fmt = 0;
1719     push @formats, AtomName $fmt
1720       while $fmt = EnumClipbrdFmts $fmt;
1721   }
1722
1723 Clipboard should be opened before calling this function.  May croak if
1724 no format is present.
1725
1726 =item   EmptyClipbrd( [ $hab ] )
1727
1728 Remove all the data handles in the clipboard.  croak()s on failure.
1729 Clipboard should be opened before calling this function.
1730
1731 Recommended before assigning a value to clipboard to remove extraneous
1732 formats of data from clipboard.
1733
1734 =item ($size, $flags) = MemoryRegionSize($addr, [$size_lim, [ $interrupt ]])
1735
1736 $addr should be a memory address (encoded as integer).  This call finds
1737 the largest continuous region of memory belonging to the same memory object
1738 as $addr, and having the same memory flags as $addr. $flags is the value of
1739 the memory flag of $addr (see docs of DosQueryMem(3) for details).  If
1740 optional argumetn $size_lim is given, the search is restricted to the region
1741 this many bytes long (after $addr).
1742
1743 ($addr and $size are rounded so that all the memory pages containing
1744 the region are inspected.)  Optional argument $interrupt (defaults to 1)
1745 specifies whether region scan should be interruptable by signals.
1746
1747 =back
1748
1749 Use class C<OS2::localClipbrd> to ensure that clipboard is closed even if
1750 the code in the block made a non-local exit.
1751
1752 See L<"OS2::localMorphPM and OS2::localClipbrd classes">.
1753
1754 =head2 Control of the PM atom tables
1755
1756 Low-level methods to access the atom table(s).  $atomtable defaults to
1757 the SystemAtomTable().
1758
1759 =over
1760
1761 =item   AddAtom($name, [$atomtable])
1762
1763 Returns the atom; increments the use count unless $name is a name of an
1764 integer atom.
1765
1766 =item   FindAtom($name, [$atomtable])
1767
1768 Returns the atom if it exists, 0 otherwise (actually, croaks).
1769
1770 =item   DeleteAtom($name, [$atomtable])
1771
1772 Decrements the use count unless $name is a name of an integer atom.
1773 When count goes to 0, association of the name to an integer is removed.
1774 (Version with prepended underscore returns 0 on success.)
1775
1776 =item   AtomName($atom, [$atomtable])
1777
1778 Returns the name of the atom.  Integer atoms have names of format C<"#ddddd">
1779 of variable length up to 7 chars.
1780
1781 =item   AtomLength($atom, [$atomtable])
1782
1783 Returns the length of the name of the atom.  Return of 0 means that no
1784 such atom exists (but usually croaks in such a case).
1785
1786 Integer atoms always return length 6.
1787
1788 =item   AtomUsage($name, [$atomtable])
1789
1790 Returns the usage count of the atom.
1791
1792 =item   SystemAtomTable()
1793
1794 Returns central atom table accessible to any process.
1795
1796 =item   CreateAtomTable( [ $initial, [ $buckets ] ] )
1797
1798 Returns new per-process atom table.  See docs for WinCreateAtomTable(3).
1799
1800 =item   DestroyAtomTable($atomtable)
1801
1802 Dispose of the table. (Version with prepended underscore returns 0 on success.)
1803
1804
1805 =back
1806
1807 =head2 Alerting the user
1808
1809 =over
1810
1811 =item Alarm([$type])
1812
1813 Audible alarm of type $type (defaults to C<WA_ERROR=2>).  Other useful
1814 values are C<WA_WARNING=0>, C<WA_NOTE=1>.  (What is C<WA_CDEFALARMS=3>???)
1815
1816 The duration and frequency of the alarms can be changed by the
1817 OS2::SysValues_set(). The alarm frequency is defined to be in the range 0x0025
1818 through 0x7FFF. The alarm is not generated if system value SV_ALARM is set
1819 to FALSE. The alarms are dependent on the device capability.
1820
1821 =item FlashWindow($hwnd, $doFlash)
1822
1823 Starts/stops (depending on $doFlash being TRUE/FALSE) flashing the window
1824 $hwnd's borders and titlebar.  First 5 flashes are accompanied by alarm beeps.
1825
1826 Example (for VIO applications):
1827
1828   { my $morph = OS2::localMorphPM->new(0);
1829     print STDERR "Press ENTER!\n";
1830     FlashWindow(process_hwnd, 1);
1831     <>;
1832     FlashWindow(process_hwnd, 0);
1833   }
1834
1835 Since flashing window persists even when application ends, it is very
1836 important to protect the switching off flashing from non-local exits.  Use
1837 the class C<OS2::localFlashWindow> for this.  Creating the object of this
1838 class starts flashing the window until the object is destroyed.  The above
1839 example becomes:
1840
1841   print STDERR "Press ENTER!\n";
1842   { my $flash = OS2::localFlashWindow->new( process_hwnd );
1843     <>;
1844   }
1845
1846 B<Notes from IBM docs:> Flashing a window brings the user's attention to a
1847 window that is not the active window, where some important message or dialog
1848 must be seen by the user.
1849
1850 Note:  It should be used only for important messages, for example, where some
1851 component of the system is failing and requires immediate attention to avoid
1852 damage.
1853
1854 =item MessageBox($text, [ $title, [$flags, ...] ])
1855
1856 Shows a simple messagebox with (optional) icon, message $text, and one or
1857 more buttons to dismiss the box.  Returns the indicator of which action was
1858 taken by the user.  If optional argument $title is not given,
1859 the title is constructed from the application name.  The optional argument
1860 $flags describes the appearance of the box; the default is to have B<Cancel>
1861 button, I<INFO>-style icon, and a border for moving.  Flags should be
1862 a combination of
1863
1864  Buttons on the box: or Button Group
1865      MB_OK                 OK
1866      MB_OKCANCEL           both OK and CANCEL
1867      MB_CANCEL             CANCEL
1868      MB_ENTER              ENTER
1869      MB_ENTERCANCEL        both ENTER and CANCEL
1870      MB_RETRYCANCEL        both RETRY and CANCEL
1871      MB_ABORTRETRYIGNORE   ABORT, RETRY, and IGNORE
1872      MB_YESNO              both YES and NO
1873      MB_YESNOCANCEL        YES, NO, and CANCEL
1874
1875  Color or Icon
1876      MB_ICONHAND           a small red circle with a red line across it.
1877      MB_ERROR              a small red circle with a red line across it.
1878      MB_ICONASTERISK       an information (i) icon.
1879      MB_INFORMATION        an information (i) icon.
1880      MB_ICONEXCLAMATION    an exclamation point (!) icon.
1881      MB_WARNING            an exclamation point (!) icon.
1882      MB_ICONQUESTION       a question mark (?) icon.
1883      MB_QUERY              a question mark (?) icon.
1884      MB_NOICON             No icon.
1885
1886  Default action (i.e., focussed button; default is MB_DEFBUTTON1)
1887      MB_DEFBUTTON1         The first button is the default selection.
1888      MB_DEFBUTTON2         The second button is the default selection.
1889      MB_DEFBUTTON3         The third button is the default selection.
1890
1891  Modality indicator
1892      MB_APPLMODAL                  Message box is application modal (default).
1893      MB_SYSTEMMODAL                Message box is system modal.
1894
1895  Mobility indicator
1896      MB_MOVEABLE                   Message box is moveable.
1897
1898 With C<MB_MOVEABLE> the message box is displayed with a title bar and a
1899 system menu, which shows only the Move, Close, and Task Manager choices,
1900 which can be selected either by use of the pointing device or by
1901 accelerator keys.  If the user selects Close, the message box is removed
1902 and the usResponse is set to C<MBID_CANCEL>, whether or not a cancel button
1903 existed within the message box.
1904
1905 C<Esc> key dismisses the dialogue only if C<CANCEL> button is present; the
1906 return value is C<MBID_CANCEL>.
1907
1908 With C<MB_APPLMODAL> the owner of the dialogue is disabled; therefore, do not
1909 specify the owner as the parent if this option is used.
1910
1911 Additionally, the following flag is possible, but probably not very useful:
1912
1913  Help button
1914      MB_HELP             a HELP button appears, which sends a WM_HELP
1915                                  message is sent to the window procedure of the
1916                                  message box.
1917
1918 Other optional arguments: $parent window, $owner_window, $helpID (used with
1919 C<WM_HELP> message if C<MB_HELP> style is given).
1920
1921 The return value is one of
1922
1923   MBID_ENTER           ENTER was selected
1924   MBID_OK              OK was selected
1925   MBID_CANCEL          CANCEL was selected
1926   MBID_ABORT           ABORT was selected
1927   MBID_RETRY           RETRY was selected
1928   MBID_IGNORE          IGNORE was selected
1929   MBID_YES             YES was selected
1930   MBID_NO              NO was selected
1931
1932   0                        Function not successful; an error occurred.
1933
1934 B<BUGS???> keyboard transversal by pressing C<TAB> key does not work.
1935 Do not appear in window list, so may be hard to find if covered by other
1936 windows.
1937
1938 =item _MessageBox($text, [ $title, [$flags, ...] ])
1939
1940 Similar to MessageBox(), but the default $title does not depend on the name
1941 of the script.
1942
1943 =item MessageBox2($text, [ $buttons_Icon, [$title, ...] ])
1944
1945 Similar to MessageBox(), but allows more flexible choice of button texts
1946 and the icon. $buttons_Icon is a reference to an array with information about
1947 buttons and the icon to use; the semantic of this array is the same as
1948 for argument list of process_MB2_INFO().  The default value will show
1949 one button B<Dismiss> which will return C<0x1000>.
1950
1951 Other optional arguments are the same as for MessageBox().
1952
1953 B<NOTE.> Remark about C<MBID_CANCEL> in presence of C<MB_MOVABLE> is
1954 equally applicable to MessageBox() and MessageBox2().
1955
1956 Example:
1957
1958   print MessageBox2
1959     'Foo prints 100, Bar 101, Baz 102',
1960     [['~Foo' => 100, 'B~ar' => 101, ['Ba~z'] => 102]],
1961     'Choose a number to print';
1962
1963 will show a messagebox with
1964
1965 =over 20
1966
1967 =item Title
1968
1969 B<Choose a number to print>,
1970
1971 =item Text
1972
1973 B<Foo prints 100, Bar 101, Baz 102>
1974
1975 =item Icon
1976
1977 INFORMATION ICON
1978
1979 =item Buttons
1980
1981 B<Foo>, B<Bar>, B<Baz>
1982
1983 =item Default button
1984
1985 B<Baz>
1986
1987 =item accelerator keys
1988
1989 B<F>, B<a>, and B<z>
1990
1991 =item return values
1992
1993 100, 101, and 102 correspondingly,
1994
1995 =back
1996
1997 Using
1998
1999   print MessageBox2
2000     'Foo prints 100, Bar 101, Baz 102',
2001     [['~Foo' => 100, 'B~ar' => 101, ['Ba~z'] => 102], 'SP#22'],
2002     'Choose a number to print';
2003
2004 will show the 22nd system icon as the dialog icon (small folder icon).
2005
2006 =item _MessageBox2($text, $buttons_Icon_struct, [$title, ...])
2007
2008 low-level workhorse to implement MessageBox2().  Differs by the dafault
2009 $title, and that $buttons_Icon_struct is required, and is a string with
2010 low-level C struct.
2011
2012 =item process_MB2_INFO($buttons, [$iconID, [$flags, [$notifyWindow]]])
2013
2014 low-level workhorse to implement MessageBox2(); calculates the second
2015 argument of _MessageBox2().  $buttons is a reference
2016 to array of button descriptions.  $iconID is either an ID of icon for
2017 the message box, or a string of the form C<"SP#number">; in the latter case
2018 the number's system icon is chosen; this field is ignored unless
2019 $flags contains C<MB_CUSTOMICON> flag.  $flags has the same meaning as mobility,
2020 modality, and icon flags for MessageBox() with addition of extra flags
2021
2022      MB_CUSTOMICON         Use a custom icon specified in hIcon.
2023      MB_NONMODAL           Message box is nonmodal
2024
2025 $flags defaults to C<MB_INFORMATION> or C<MB_CUSTOMICON> (depending on whether
2026 $iconID is non-0), combined with MB_MOVABLE.
2027
2028 Each button's description takes two elements of the description array,
2029 appearance description, and the return value of MessageBox2() if this
2030 button is selected.  The appearance description is either an array reference
2031 of the form C<[$button_Text, $button_Style]>, or the same without
2032 $button_Style (then style is C<BS_DEFAULT>, making this button the default)
2033 or just $button_Text (with "normal" style).  E.g., the list
2034
2035   Foo => 100, Bar => 101, [Baz] => 102
2036
2037 will show three buttons B<Foo>, B<Bar>, B<Baz> with B<Baz> being the default
2038 button; pressing buttons return 100, 101, or 102 correspondingly.
2039
2040 In particular, exactly one button should have C<BS_DEFAULT> style (e.g.,
2041 given as C<[$button_Name]>); otherwise the message box will not have keyboard
2042 focus!  (The only exception is the case of one button; then C<[$button_Name]>
2043 can be replaced (for convenience) with plain C<$button_Name>.)
2044
2045 If text of the button contains character C<~>, the following character becomes
2046 the keyboard accelerator for this button.  One can also get the handle
2047 of system icons directly, so C<'SP#22'> can be replaced by
2048 C<OS2::Process::get_pointer(22)>; see also C<SPTR_*> constants.
2049
2050 B<NOTE> With C<MB_NONMODAL> the program continues after displaying the
2051 nonmodal message box.  The message box remains visible until the owner window
2052 destroys it. Two notification messages, WM_MSGBOXINIT and WM_MSGBOXDISMISS,
2053 are used to support this non-modality.
2054
2055 =item LoadPointer($id, [$module, [$hwnd]])
2056
2057 Loads a handle for the pointer $id from the resources of the module
2058 $module on desktop $hwnd.  If $module is 0 (default), loads from the main
2059 executable; otherwise from a DLL with the handle $module.
2060
2061 The pointer is owned by the process, and is destroyed by
2062 DestroyPointer() call, or when the process terminates.
2063
2064 =item SysPointer($id, [$copy, [$hwnd]])
2065
2066 Gets a handle for (a copy of) the system pointer $id (the value should
2067 be one of C<SPTR_*> constants).  A copy is made if $copy is TRUE (the
2068 default).  $hwnd defaults to C<HWND_DESKTOP>.
2069
2070 =item get_pointer($id, [$copy, [$hwnd]])
2071
2072 Gets (and caches) a copy of the system pointer.
2073
2074 =back
2075
2076 =head2 Constants used by OS/2 APIs
2077
2078 Function C<os2constant($name)> returns the value of the constant; to
2079 decrease the memory usage of this package, only the constants used by
2080 APIs called by Perl functions in this package are made available.
2081
2082 For direct access, see also the L<"EXPORTS"> section; the latter way
2083 may also provide some performance advantages, since the value of the
2084 constant is cached.
2085
2086 =head1 OS2::localMorphPM, OS2::localFlashWindow, and OS2::localClipbrd classes
2087
2088 The class C<OS2::localMorphPM> morphs the process to PM for the duration of
2089 the given scope.
2090
2091   {
2092     my $h = OS2::localMorphPM->new(0);
2093     # Do something
2094   }
2095
2096 The argument has the same meaning as one to OS2::MorphPM().  Calls can
2097 nest with internal ones being NOPs.
2098
2099 Likewise, C<OS2::localClipbrd> class opens the clipboard for the duration
2100 of the current scope; if TRUE optional argument is given, it would not
2101 morph the application into PM:
2102
2103   {
2104     my $handle = OS2::localClipbrd->new(1);     # Do not morph into PM
2105     # Do something with clipboard here...
2106   }
2107
2108 C<OS2::localFlashWindow> behaves similarly; see
2109 L<"FlashWindow($hwnd,$doFlash)">.
2110
2111 =head1 EXAMPLES
2112
2113 The test suite for this module contains an almost comprehensive collection
2114 of examples of using the API of this module.
2115
2116 =head1 TODO
2117
2118 Add tests for:
2119
2120         SwitchToProgram
2121         ClassName
2122         out_codepage
2123         out_codepage_set
2124         in_codepage
2125         in_codepage_set
2126         cursor
2127         cursor_set
2128         screen
2129         screen_set
2130         process_codepages
2131         QueryWindow
2132         EnumDlgItem
2133         WindowPtr
2134         WindowUShort
2135         SetWindowBits
2136         SetWindowPtr
2137         SetWindowULong
2138         SetWindowUShort
2139         my_type
2140         file_type
2141         scrsize
2142         scrsize_set
2143
2144 Document: InvalidateRect,
2145 CreateFrameControls, kbdChar, kbdhChar,
2146 kbdStatus, _kbdStatus_set, kbdhStatus, kbdhStatus_set,
2147 vioConfig, viohConfig, vioMode, viohMode, viohMode_set, _vioMode_set,
2148 _vioState, _vioState_set, vioFont, vioFont_set
2149
2150 Test: SetWindowULong/Short/Ptr, SetWindowBits. InvalidateRect,
2151 CreateFrameControls, ClipbrdOwner_set, ClipbrdViewer_set, _ClipbrdData_set,
2152 Alarm, FlashWindow, _MessageBox, MessageBox, _MessageBox2, MessageBox2,
2153 LoadPointer, SysPointer, kbdChar, kbdhChar, kbdStatus, _kbdStatus_set,
2154 kbdhStatus,  kbdhStatus_set, vioConfig, viohConfig, vioMode, viohMode,
2155 viohMode_set, _vioMode_set, _vioState, _vioState_set, vioFont, vioFont_set
2156
2157 Implement SOMETHINGFROMMR.
2158
2159
2160   >But I wish to change the default button if the user enters some
2161   >text into an entryfield.  I can detect the entry ok, but can't
2162   >seem to get the button to change to default.
2163   >
2164   >No matter what message I send it, it's being ignored.
2165
2166   You need to get the style of the buttons using WinQueryWindowULong/QWL_STYLE,
2167   set and reset the BS_DEFAULT bits as appropriate and then use
2168   WinSetWindowULong/QWL_STYLE to set the button style.
2169   Something like this:
2170     hwnd1 = WinWindowFromID (hwnd, id1);
2171     hwnd2 = WinWindowFromID (hwnd, id2);
2172     style1 = WinQueryWindowULong (hwnd1, QWL_STYLE);
2173     style2 = WinQueryWindowULong (hwnd2, QWL_STYLE);
2174     style1 |= style2 & BS_DEFAULT;
2175     style2 &= ~BS_DEFAULT;
2176     WinSetWindowULong (hwnd1, QWL_STYLE, style1);
2177     WinSetWindowULong (hwnd2, QWL_STYLE, style2);
2178
2179  > How to do query and change a frame creation flags for existing window?
2180
2181  Set the style bits that correspond to the FCF_* flag for the frame
2182  window and then send a WM_UPDATEFRAME message with the appropriate FCF_*
2183  flag in mp1.
2184
2185  ULONG ulFrameStyle;
2186  ulFrameStyle = WinQueryWindowULong( WinQueryWindow(hwnd, QW_PARENT),
2187  QWL_STYLE );
2188  ulFrameStyle = (ulFrameStyle & ~FS_SIZEBORDER) | FS_BORDER;
2189  WinSetWindowULong(   WinQueryWindow(hwnd, QW_PARENT),
2190                       QWL_STYLE,
2191                       ulFrameStyle );
2192  WinSendMsg( WinQueryWindow(hwnd, QW_PARENT),
2193              WM_UPDATEFRAME,
2194              MPFROMP(FCF_SIZEBORDER),
2195              MPVOID );
2196
2197  If the FCF_* flags you want to change does not have a corresponding FS_*
2198  style (i.e. the FCF_* flag corresponds to the presence/lack of a frame
2199  control rather than a property of the frame itself) then you create or
2200  destroy the appropriate control window using the correct FID_* window
2201  identifier and then send the WM_UPDATEFRAME message with the appropriate
2202  FCF_* flag in mp1.
2203
2204  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*
2205   |  SetFrameBorder()                                                          |
2206   |    Changes a frame window's border to the requested type.                  |
2207   |                                                                            |
2208   |  Parameters on entry:                                                      |
2209   |    hwndFrame     -> Frame window whose border is to be changed.            |
2210   |    ulBorderStyle -> Type of border to change to.                           |
2211   |                                                                            |
2212   |  Returns:                                                                  |
2213   |    BOOL          -> Success indicator.                                     |
2214   |                                                                            |
2215   * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
2216  BOOL SetFrameBorder( HWND hwndFrame, ULONG ulBorderType )  {
2217    ULONG  ulFrameStyle;
2218    BOOL   fSuccess = TRUE;
2219
2220    ulFrameStyle = WinQueryWindowULong( hwndFrame, QWL_STYLE );
2221
2222    switch ( ulBorderType )  {
2223      case FS_SIZEBORDER :
2224        ulFrameStyle = (ulFrameStyle & ~(FS_DLGBORDER | FS_BORDER))
2225                       | FS_SIZEBORDER;
2226        break;
2227
2228      case FS_DLGBORDER :
2229        ulFrameStyle = (ulFrameStyle & ~(FS_SIZEBORDER | FS_BORDER))
2230                       | FS_DLGBORDER;
2231        break;
2232
2233      case FS_BORDER :
2234        ulFrameStyle = (ulFrameStyle & ~(FS_SIZEBORDER | FS_DLGBORDER))
2235                       | FS_BORDER;
2236        break;
2237
2238      default :
2239        fSuccess = FALSE;
2240        break;
2241    }  // end switch
2242
2243    if ( fSuccess )  {
2244      fSuccess = WinSetWindowULong( hwndFrame, QWL_STYLE, ulFrameStyle );
2245
2246      if ( fSuccess )  {
2247        fSuccess = (BOOL)WinSendMsg( hwndFrame, WM_UPDATEFRAME, 0, 0 );
2248        if ( fSuccess )
2249          fSuccess = WinInvalidateRect( hwndFrame, NULL, TRUE );
2250      }
2251    }
2252
2253    return ( fSuccess );
2254
2255  }  // End SetFrameBorder()
2256
2257          hwndMenu=WinLoadMenu(hwndParent,NULL,WND_IMAGE);
2258          WinSetWindowUShort(hwndMenu,QWS_ID,FID_MENU);
2259          ulStyle=WinQueryWindowULong(hwndMenu,QWL_STYLE);
2260          WinSetWindowULong(hwndMenu,QWL_STYLE,ulStyle|MS_ACTIONBAR);
2261          WinSendMsg(hwndParent,WM_UPDATEFRAME,MPFROMSHORT(FCF_MENU),0L);
2262
2263   OS/2-windows have another "parent" called the *owner*,
2264   which must be set separately - to get a close relationship:
2265
2266     WinSetOwner (hwndFrameChild, hwndFrameMain);
2267
2268   Now your child should move with your main window!
2269   And always stays on top of it....
2270
2271   To avoid this, for example for dialogwindows, you can
2272   also "disconnect" this relationship with:
2273
2274     WinSetWindowBits (hwndFrameChild, QWL_STYLE
2275                       , FS_NOMOVEWITHOWNER
2276                       , FS_NOMOVEWITHOWNER);
2277
2278  Adding a button icon later:
2279
2280  /* switch the button style to BS_MINIICON */
2281  WinSetWindowBits(hwndBtn, QWL_STYLE, BS_MINIICON, BS_MINIICON) ;
2282
2283  /* set up button control data */
2284  BTNCDATA    bcd;
2285  bcd.cb = sizeof(BTNCDATA);
2286  bcd.hImage = WinLoadPointer(HWND_DESKTOP, dllHandle, ID_ICON_BUTTON1) ;
2287  bcd.fsCheckState = bcd.fsHiliteState = 0 ;
2288
2289
2290  WNDPARAMS   wp;
2291  wp.fsStatus = WPM_CTLDATA;
2292  wp.pCtlData = &bcd;
2293
2294  /* add the icon on the button */
2295  WinSendMsg(hwndBtn, WM_SETWINDOWPARAMS, (MPARAM)&wp, NULL);
2296
2297  MO> Can anyone tell what OS/2 expects of an application to be properly
2298  MO> minimized to the desktop?
2299  case WM MINMAXFRAME :
2300  {
2301    BOOL  fShow = ! (((PSWP) mp1)->fl & SWP MINIMIZE);
2302    HENUM henum;
2303
2304    HWND  hwndChild;
2305
2306    WinEnableWindowUpdate ( hwnd, FALSE );
2307
2308    for (henum=WinBeginEnumWindows(hwnd);
2309         (hwndChild = WinGetNextWindow (henum)) != 0; )
2310    WinShowWindow ( hwndChild, fShow );
2311
2312    WinEndEnumWindows ( henum );
2313    WinEnableWindowUpdate ( hwnd, TRUE );
2314  }
2315  break;
2316
2317 Why C<hWindowPos DesktopWindow> gives C<< behind => HWND_TOP >>?
2318
2319 =head1 $^E
2320
2321 the majority of the APIs of this module set $^E on failure (no matter
2322 whether they die() on failure or not).  By the semantic of PM API
2323 which returns something other than a boolean, it is impossible to
2324 distinguish failure from a "normal" 0-return.  In such cases C<$^E ==
2325 0> indicates an absence of error.
2326
2327 =head1 EXPORTS
2328
2329 In addition to symbols described above, the following constants (available
2330 also via module C<OS2::Process::Const>) are exportable.  Note that these
2331 symbols live in package C<OS2::Process::Const>, they are not available
2332 by full name through C<OS2::Process>!
2333
2334   HWND_*                Standard (abstract) window handles
2335   WM_*                  Message ids
2336   SC_*                  WM_SYSCOMMAND flavor
2337   SWP_*                 Size/move etc flag
2338   WC_*                  Standard window classes
2339   PROG_*                Program category (PM, VIO etc)
2340   QW_*                  Query-Window flag
2341   EDI_*                 Enumerate-Dialog-Item code
2342   WS_*                  Window Style flag
2343   QWS_*                 Query-window-UShort offsets
2344   QWP_*                 Query-window-pointer offsets
2345   QWL_*                 Query-window-ULong offsets
2346   FF_*                  Frame-window state flags
2347   FI_*                  Frame-window information flags
2348   LS_*                  List box styles
2349   FS_*                  Frame style
2350   FCF_*                 Frame creation flags
2351   BS_*                  Button style
2352   MS_*                  Menu style
2353   TBM_*                 Title bar messages?
2354   CF_*                  Clipboard formats
2355   CFI_*                 Clipboard storage type
2356   FID_*                 ids of subwindows of frames
2357
2358 =head1 BUGS
2359
2360 whether a given API dies or returns FALSE/empty-list on error may be
2361 confusing.  This may change in the future.
2362
2363 =head1 AUTHOR
2364
2365 Andreas Kaiser <ak@ananke.s.bawue.de>,
2366 Ilya Zakharevich <ilya@math.ohio-state.edu>.
2367
2368 =head1 SEE ALSO
2369
2370 C<spawn*>() system calls, L<OS2::Proc> and L<OS2::WinObject> modules.
2371
2372 =cut