1package OS2::localMorphPM; 2# use strict; 3 4sub new { 5 my ($c,$f) = @_; 6 OS2::MorphPM($f); 7 # print STDERR ">>>>>\n"; 8 bless [$f], $c 9} 10sub DESTROY { 11 # print STDERR "<<<<<\n"; 12 OS2::UnMorphPM(shift->[0]) 13} 14 15package OS2::Process; 16 17BEGIN { 18 require Exporter; 19 require XSLoader; 20 #require AutoLoader; 21 22 our @ISA = qw(Exporter); 23 our $VERSION = "1.12"; 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. 30our @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); 203our @EXPORT_OK = qw( 204 ResetWinError 205 MPFROMSHORT 206 MPVOID 207 MPFROMCHAR 208 MPFROM2SHORT 209 MPFROMSH2CH 210 MPFROMLONG 211); 212 213our $AUTOLOAD; 214 215sub 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 235sub 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 243sub 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 255sub 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 267sub Title () { (process_entry())[0] } 268 269# *Title_set = \&sesmgr_title_set; 270 271sub swTitle_set_sw { 272 my ($title, @sw) = @_; 273 $sw[0] = $title; 274 change_entry(@sw); 275} 276 277sub swTitle_set ($) { 278 my (@sw) = process_entry(); 279 swTitle_set_sw(shift, @sw); 280} 281 282sub winTitle_set_sw { 283 my ($title, @sw) = @_; 284 my $h = OS2::localMorphPM->new(0); 285 WindowText_set $sw[1], $title; 286} 287 288sub winTitle_set ($) { 289 my (@sw) = process_entry(); 290 winTitle_set_sw(shift, @sw); 291} 292 293sub winTitle () { 294 my (@sw) = process_entry(); 295 my $h = OS2::localMorphPM->new(0); 296 WindowText $sw[1]; 297} 298 299sub 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 306sub 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 315sub process_entry { swentry_expand(process_swentry(@_)) } 316 317our @hentry_fields = qw( title owner_hwnd icon_hwnd 318 owner_phandle owner_pid owner_sid 319 visible nonswitchable jumpable ptype sw_entry ); 320 321sub swentry_hexpand ($) { 322 my %h; 323 @h{@hentry_fields} = swentry_expand(shift); 324 \%h; 325} 326 327sub process_hentry { swentry_hexpand(process_swentry(@_)) } 328sub process_hwnd { process_hentry()->{owner_hwnd} } 329 330my $swentry_size = swentry_size(); 331 332sub 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 341sub process_entries () { 342 map [swentry_expand($_)], sw_entries; 343} 344 345sub process_hentries () { 346 map swentry_hexpand($_), sw_entries; 347} 348 349sub change_entry { 350 change_swentry(create_swentry(@_)); 351} 352 353sub create_swentryh ($) { 354 my $h = shift; 355 create_swentry(@$h{@hentry_fields}); 356} 357 358sub change_entryh ($) { 359 change_swentry(create_swentryh(shift)); 360} 361 362# Massage entries into the same order as WindowPos_set: 363sub 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 370sub 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 377my @SWP_keys = ( [qw(width height)], # SWP_SIZE=1 378 [qw(x y)], # SWP_MOVE=2 379 [qw(behind)] ); # SWP_ZORDER=3 380my %SWP_def; 381@SWP_def{ map @$_, @SWP_keys } = (0) x 20; 382 383# Get them from a hash 384sub 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 407sub 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 417sub 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 427sub 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 438sub WindowStyle ($) { 439 WindowULong(shift,-2); # QWL_STYLE 440} 441 442sub 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} 450sub OS2::localClipbrd::DESTROY { 451 # print STDERR "<<<<<\n"; 452 CloseClipbrd(); 453} 454 455sub 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} 462sub 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) 468sub 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 477sub 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 486sub ClipbrdTextUCS2le (@) { 487 my $txt = ClipbrdText_2byte @_; # little-endian shorts 488 #require Unicode::String; 489 pack "U*", unpack "v*", $txt; 490} 491 492sub 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 499sub 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 508sub ClipbrdFmtNames { 509 map AtomName($_), ClipbrdFmtAtoms(@_); 510} 511 512sub 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 519my %pointers; 520 521sub 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. 530sub 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. 543sub 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]] 572sub 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 585my %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 599sub 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; 634sub 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 646my @vioConfig = qw(adapter display cbMemory Configuration VDHVersion Flags 647 HWBufferSize FullSaveSize PartSaveSize EMAdapters EMDisplays); 648 649sub 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; 657sub vioMode() {unpack 'x[S]CCSSSSCCLLLLL', _vioMode} 658 659my @vioMode = qw( fbType color col row hres vres fmt_ID attrib buf_addr 660 buf_length full_length partial_length ext_data_addr); 661 662sub viohMode() { 663 my %h; 664 @h{@vioMode} = vioMode; 665 %h; 666} 667 668sub 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 675sub kbdChar (;$$) {unpack 'CCCCSL', &_kbdChar} 676 677my @kbdChar = qw(ascii scancode status nlsstate shifts time); 678sub kbdhChar (;$$) { 679 my %h; 680 @h{@kbdChar} = &kbdChar; 681 %h 682} 683 684sub kbdStatus (;$) {unpack 'x[S]SSSS', &_kbdStatus} 685my @kbdStatus = qw(state turnChar intCharFlags shifts); 686sub kbdhStatus (;$) { 687 my %h; 688 @h{@kbdStatus} = &kbdStatus; 689 %h 690} 691sub 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(@_) } 700sub DeleteAtom { !_DeleteAtom(@_) } 701sub 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??? 708sub __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 725sub __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 774my $c = 0; 775sub 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); 805EOS 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 8341; 835__END__ 836 837=head1 NAME 838 839OS2::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 850the builtin function system() under OS/2 allows an optional first 851argument which denotes the mode of the process. Note that this argument is 852recognized only if it is strictly numerical. 853 854You 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 862and 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 881On OS/2 processes have the usual I<parent/child> semantic; 882additionally, there is a hierarchy of sessions with their own 883I<parent/child> tree. A session is either a FS session, or a windowed 884pseudo-session created by PM. A session is a "unit of user 885interaction", a change to in/out settings in one of them does not 886affect other sessions. 887 888=over 889 890=item my_type() 891 892returns 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 897returns the type of the executable file C<file>, or 898dies 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 904Application type is not specified in the executable header. 905 906=item C<T_NOTWINDOWCOMPAT> (1) 907 908Application type is not-window-compatible. 909 910=item C<T_WINDOWCOMPAT> (2) 911 912Application type is window-compatible. 913 914=item C<T_WINDOWAPI> (3) 915 916Application type is window-API. 917 918=back 919 920The remaining bits should be masked with the following values to 921determine the type of the executable: 922 923=over 924 925=item C<T_BOUND> (8) 926 927Set to 1 if the executable file has been "bound" (by the BIND command) 928as a Family API application. Bits 0, 1, and 2 still apply. 929 930=item C<T_DLL> (0x10) 931 932Set to 1 if the executable file is a dynamic link library (DLL) 933module. Bits 0, 1, 2, 3, and 5 will be set to 0. 934 935=item C<T_DOS> (0x20) 936 937Set to 1 if the executable file is in PC/DOS format. Bits 0, 1, 2, 3, 938and 4 will be set to 0. 939 940=item C<T_PHYSDRV> (0x40) 941 942Set to 1 if the executable file is a physical device driver. 943 944=item C<T_VIRTDRV> (0x80) 945 946Set to 1 if the executable file is a virtual device driver. 947 948=item C<T_PROTDLL> (0x100) 949 950Set to 1 if the executable file is a protected-memory dynamic link 951library module. 952 953=item C<T_32BIT> (0x4000) 954 955Set to 1 for 32-bit executable files. 956 957=back 958 959file_type() may croak with one of the strings C<"Invalid EXE 960signature"> or C<"EXE marked invalid"> to indicate typical error 961conditions. If given non-absolute path, will look on C<PATH>, will 962add extension F<.exe> if no extension is present (add extension F<.> 963to suppress). 964 965=item C<@list = process_codepages()> 966 967the first element is the currently active codepage, up to 2 additional 968entries specify the system's "prepared codepages": the codepages the 969user can switch to. The active codepage of a process is one of the 970prepared codepages of the system (if present). 971 972=item C<process_codepage_set($cp)> 973 974sets the currently active codepage. [Affects printer output, in/out 975codepages of sessions started by this process, and the default 976codepage for drawing in PM; is inherited by kids. Does not affect the 977out- and in-codepages of the session.] 978 979=item ppid() 980 981returns the PID of the parent process. 982 983=item C<ppidOf($pid = $$)> 984 985returns the PID of the parent process of $pid. -1 on error. 986 987=item C<sidOf($pid = $$)> 988 989returns the session id of the process id $pid. -1 on error. 990 991=back 992 993=head2 Control of VIO sessions 994 995VIO applications are applications running in a text-mode session. 996 997=over 998 999=item out_codepage() 1000 1001gets code page used for screen output (glyphs). -1 means that a user font 1002was loaded. 1003 1004=item C<out_codepage_set($cp)> 1005 1006sets code page used for screen output (glyphs). -1 switches to a preloaded 1007user font. -2 switches off the preloaded user font. 1008 1009=item in_codepage() 1010 1011gets code page used for keyboard input. 0 means that a hardware codepage 1012is used. 1013 1014=item C<in_codepage_set($cp)> 1015 1016sets code page used for keyboard input. 1017 1018=item C<($w, $h) = scrsize()> 1019 1020width and height of the given console window in character cells. 1021 1022=item C<scrsize_set([$w, ] $h)> 1023 1024set height (and optionally width) of the given console window in 1025character cells. Use 0 size to keep the old size. 1026 1027=item C<($s, $e, $w, $a) = cursor()> 1028 1029gets 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 1031values mean visible, in graphic modes color). 1032 1033=item C<cursor_set($s, $e, [$w [, $a]])> 1034 1035sets start/end lines of the blinking cursor in the charcell. Negative 1036values mean percents of the character cell height. 1037 1038=item screen() 1039 1040gets a buffer with characters and attributes of the screen. 1041 1042=item C<screen_set($buffer)> 1043 1044restores the screen given the result of screen(). E.g., if the file 1045C<$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 1055will restore the screen content even if the height of the window 1056changed (if the width changed, more manipulation is needed). 1057 1058=back 1059 1060=head2 Control of the process list 1061 1062With the exception of Title_set(), all these calls require that PM is 1063running, they would not work under alternative Session Managers. 1064 1065=over 1066 1067=item process_entry() 1068 1069returns a list of the following data: 1070 1071=over 1072 1073=item * 1074 1075Title of the process (in the C<Ctrl-Esc> list); 1076 1077=item * 1078 1079window handle of switch entry of the process (in the C<Ctrl-Esc> list); 1080 1081=item * 1082 1083window handle of the icon of the process; 1084 1085=item * 1086 1087process handle of the owner of the entry in C<Ctrl-Esc> list; 1088 1089=item * 1090 1091process id of the owner of the entry in C<Ctrl-Esc> list; 1092 1093=item * 1094 1095session id of the owner of the entry in C<Ctrl-Esc> list; 1096 1097=item * 1098 1099whether visible in C<Ctrl-Esc> list; 1100 1101=item * 1102 1103whether item cannot be switched to (note that it is not actually 1104grayed in the C<Ctrl-Esc> list)); 1105 1106=item * 1107 1108whether participates in jump sequence; 1109 1110=item * 1111 1112program 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 1121Although there are several other program types for WIN-OS/2 programs, 1122these do not show up in this field. Instead, the PROG_VDM or 1123PROG_WINDOWEDVDM program types are used. For instance, for 1124PROG_31_STDSEAMLESSVDM, PROG_WINDOWEDVDM is used. This is because all 1125the WIN-OS/2 programs run in DOS sessions. For example, if a program 1126is a windowed WIN-OS/2 program, it runs in a PROG_WINDOWEDVDM 1127session. Likewise, if it's a full-screen WIN-OS/2 program, it runs in 1128a PROG_VDM session. 1129 1130=item * 1131 1132switch-entry handle. 1133 1134=back 1135 1136Optional arguments: the pid and the window-handle of the application running 1137in the OS/2 session to query. 1138 1139=item process_hentry() 1140 1141similar 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 1150similar to process_entry(), but returns a list of array reference for all 1151the elements in the switch list (one controlling C<Ctrl-Esc> window). 1152 1153=item process_hentries() 1154 1155similar to process_hentry(), but returns a list of hash reference for all 1156the elements in the switch list (one controlling C<Ctrl-Esc> window). 1157 1158=item change_entry() 1159 1160changes a process entry, arguments are the same as process_entry() returns. 1161 1162=item change_entryh() 1163 1164Similar to change_entry(), but takes a hash reference as an argument. 1165 1166=item process_hwnd() 1167 1168returns the C<owner_hwnd> of the process entry (for VIO windowed processes 1169this is the frame window of the session). 1170 1171=item Title() 1172 1173returns 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 1175implementation is a shortcut via process_entry().) 1176 1177=item C<Title_set(newtitle)> 1178 1179tries two different interfaces. The Session Manager one does not work 1180with some windows (if the title is set from the start). 1181This is a limitation of OS/2, in such a case $^E is set to 372 (type 1182 1183 help 372 1184 1185for a funny - and wrong - explanation ;-). In such cases a 1186direct-manipulation of low-level entries is used (same as bothTitle_set()). 1187Keep in mind that some versions of OS/2 leak memory with such a manipulation. 1188 1189=item winTitle() 1190 1191returns text of the titlebar of the current process' window. 1192 1193=item C<winTitle_set(newtitle)> 1194 1195sets text of the titlebar of the current process' window. The change does not 1196affect the text of the switch entry of the current window. 1197 1198=item C<swTitle_set(newtitle)> 1199 1200sets text of the task switch menu entry of the current process' window. [There 1201is no API to query this title.] Does it via SwitchEntry interface, 1202not Session manager interface. The change does not affect the text of the 1203titlebar of the current window. 1204 1205=item C<bothTitle_set(newtitle)> 1206 1207sets text of the titlebar and task switch menu of the current process' window 1208via direct manipulation of the windows' texts. 1209 1210=item C<SwitchToProgram([$sw_entry])> 1211 1212switch to session given by a switch list handle (defaults to the entry of our process). 1213 1214Use of this function causes another window (and its related windows) 1215of a PM session to appear on the front of the screen, or a switch to 1216another session in the case of a non-PM program. In either case, 1217the keyboard (and mouse for the non-PM case) input is directed to 1218the new program. 1219 1220=back 1221 1222=head2 Control of the PM windows 1223 1224Some of these API's require sending a message to the specified window. 1225In such a case the process needs to be a PM process, or to be morphed 1226to a PM process via OS2::MorphPM(). 1227 1228For a temporary morphing to PM use the L<OS2::localMorphPM|/OS2::localMorphPM, 1229OS2::localFlashWindow, and OS2::localClipbrd classes> class. 1230 1231Keep in mind that PM windows are engaged in 2 "orthogonal" window 1232trees, as well as in the z-order list. 1233 1234One tree is given by the I<parent/child> relationship. This 1235relationship affects drawing (child is drawn relative to its parent 1236(lower-left corner), and the drawing is clipped by the parent's 1237boundary; parent may request that I<it's> drawing is clipped to be 1238confined to the outsize of the child's and/or siblings' windows); 1239hiding; minimizing/restoring; and destroying windows. 1240 1241Another tree (not necessarily connected?) is given by I<ownership> 1242relationship. Ownership relationship assumes cooperation of the 1243engaged windows via passing messages on "important events"; e.g., 1244scrollbars send information messages when the "bar" is moved, menus 1245send messages when an item is selected; frames 1246move/hide/unhide/minimize/restore/change-z-order-of owned frames when 1247the owner is moved/etc., and destroy the owned frames (even when these 1248frames are not descendants) when the owner is destroyed; etc. [An 1249important restriction on ownership is that owner should be created by 1250the same thread as the owned thread, so they engage in the same 1251message queue.] 1252 1253Windows may be in many different state: Focused (take keyboard events) or not, 1254Activated (=Frame windows in the I<parent/child> tree between the root and 1255the window with the focus; usually indicate such "active state" by titlebar 1256highlights, and take mouse events) or not, Enabled/Disabled (this influences 1257the ability to update the graphic, and may change appearance, as for 1258enabled/disabled buttons), Visible/Hidden, Minimized/Maximized/Restored, Modal 1259or not, etc. 1260 1261The APIs below all die() on error with the message being $^E. 1262 1263=over 1264 1265=item C<WindowText($hwnd)> 1266 1267gets "a text content" of a window. Requires (morphing to) PM. 1268 1269=item C<WindowText_set($hwnd, $text)> 1270 1271sets "a text content" of a window. Requires (morphing to) PM. 1272 1273=item C<($x, $y, $flags, $width, $height, $behind, @rest) = WindowPos($hwnd)> 1274 1275gets window position info as 8 integers (of C<SWP>), in the order suitable 1276for WindowPos_set(). @rest is marked as "reserved" in PM docs. $flags 1277is a combination of C<SWP_*> constants. 1278 1279=item C<$hash = hWindowPos($hwnd)> 1280 1281gets window position info as a hash reference; the keys are C<flags width 1282height x y behind hwnd reserved1 reserved2>. 1283 1284Example: 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 1290Set state of the window: position, size, zorder, show/hide, activation, 1291minimize/maximize/restore etc. Which of these operations to perform 1292is governed by $flags. 1293 1294=item C<hWindowPos_set($hash, [$hwnd])> 1295 1296Same as C<WindowPos_set>, but takes the position from keys C<fl width height 1297x y behind hwnd> of the hash referenced by $hash. If $hwnd is explicitly 1298specified, it overrides C<< $hash->{hwnd} >>. If $hash->{flags} is not specified, 1299it is calculated basing on the existing keys of $hash. Requires (morphing to) PM. 1300 1301Example: 1302 1303 hWindowPos_set {flags => SWP_MAXIMIZE}, $hwnd; # Maximize 1304 1305=item C<($pid, $tid) = WindowProcess($hwnd)> 1306 1307gets I<PID> and I<TID> of the process associated to the window. 1308 1309=item C<ClassName($hwnd)> 1310 1311returns the class name of the window. 1312 1313If this window is of any of the preregistered WC_* classes the class 1314name returned is in the form "#nnnnn", where "nnnnn" is a group 1315of up to five digits that corresponds to the value of the WC_* class name 1316constant. 1317 1318=item WindowStyle($hwnd) 1319 1320Returns the "window style" flags for window handle $hwnd. 1321 1322=item WindowULong($hwnd, $id), WindowPtr($hwnd, $id), WindowUShort($hwnd, $id) 1323 1324Return data associated to window handle $hwnd. $id should be one of 1325C<QWL_*>, C<QWP_PFNWP>, C<QWS_*> constants, or a byte offset referencing 1326a region (of length 4, 4, 2 correspondingly) fully inside C<0..cbWindowData-1>. 1327Here C<cbWindowData> is the count of extra user-specified bytes reserved 1328for the given class of windows. 1329 1330=item WindowULong_set($hwnd, $id, $value), WindowPtr_set, WindowUShort_set 1331 1332Similar to WindowULong(), WindowPtr(), WindowUShort(), but for assigning the 1333value $value. 1334 1335=item WindowBits_set($hwnd, $id, $value, $mask) 1336 1337Similar to WindowULong_set(), but will change only the bits which are 1338set in $mask. 1339 1340=item FocusWindow() 1341 1342returns the handle of the focus window. Optional argument for specifying 1343the desktop to use. 1344 1345=item C<FocusWindow_set($hwnd)> 1346 1347set the focus window by handle. Optional argument for specifying the desktop 1348to use. E.g, the first entry in program_entries() is the C<Ctrl-Esc> list. 1349To 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 1358Switching focus to currently-unfocused window moves the window to the 1359front in Z-order; use FocusWindow_set_keep_Zorder() to avoid this. 1360 1361=item C<FocusWindow_set_keep_Zorder($hwnd)> 1362 1363same as FocusWindow_set(), but preserves the Z-order of windows. 1364 1365=item C<ActiveWindow([$parentHwnd])> 1366 1367gets the active subwindow's handle for $parentHwnd or desktop. 1368Returns FALSE if none. 1369 1370=item C<ActiveWindow_set($hwnd, [$parentHwnd])> 1371 1372sets the active subwindow's handle for $parentHwnd or desktop. Requires (morphing to) PM. 1373 1374=item C<ShowWindow($hwnd [, $show])> 1375 1376Set visible/hidden flag of the window. Default: $show is TRUE. 1377 1378=item C<EnableWindowUpdate($hwnd [, $update])> 1379 1380Set window visibility state flag for the window for subsequent drawing. 1381No actual drawing is done at this moment. Use C<ShowWindow($hwnd, $state)> 1382when redrawing is needed. While update is disabled, changes to the "window 1383state" 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 1389Set the window enabled state. Default: $enable is TRUE. 1390 1391Results in C<WM_ENABLED> message sent to the window. Typically, this 1392would change the appearance of the window. If at the moment of disabling 1393focus is in the window (or a descendant), focus is lost (no focus anywhere). 1394If focus is needed, it can be reassigned explicitly later. 1395 1396=item IsWindowEnabled(), IsWindowVisible(), IsWindowShowing() 1397 1398these functions take $hwnd as an argument. IsWindowEnabled() queries 1399the state changed by EnableWindow(), IsWindowVisible() the state changed 1400by ShowWindow(), IsWindowShowing() is true if there is a part of the window 1401visible on the screen. 1402 1403=item C<PostMsg($hwnd, $msg, $mp1, $mp2)> 1404 1405post message to a window. The meaning of $mp1, $mp2 is specific for each 1406message 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 1429In fact, MPFROMSHORT() may be omitted above. 1430 1431For messages to other processes, messages which take/return a pointer are 1432not supported. 1433 1434=item C<MP*()> 1435 1436The functions MPFROMSHORT(), MPVOID(), MPFROMCHAR(), MPFROM2SHORT(), 1437MPFROMSH2CH(), MPFROMLONG() can be used the same way as from C. Use them 1438to construct parameters $m1, $m2 to PostMsg(). 1439 1440These functions are not exported by default. 1441 1442=item C<$eh = BeginEnumWindows($hwnd)> 1443 1444starts enumerating immediate child windows of $hwnd in z-order. The 1445enumeration reflects the state at the moment of BeginEnumWindows() calls; 1446use IsWindow() to be sure. All the functions in this group require (morphing to) PM. 1447 1448=item C<$kid_hwnd = GetNextWindow($eh)> 1449 1450gets the next kid in the list. Gets 0 on error or when the list ends. 1451 1452=item C<EndEnumWindows($eh)> 1453 1454End enumeration and release the list. 1455 1456=item C<@list = ChildWindows([$hwnd])> 1457 1458returns the list of child windows at the moment of the call. Same remark 1459as for enumeration interface applies. Defaults to HWND_DESKTOP. 1460Example 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 1471true if the window handle is still valid. 1472 1473=item C<QueryWindow($hwnd, $type)> 1474 1475gets the handle of a related window. $type should be one of C<QW_*> constants. 1476 1477=item C<IsChild($hwnd, $parent)> 1478 1479return TRUE if $hwnd is a descendant of $parent. 1480 1481=item C<WindowFromId($hwnd, $id)> 1482 1483return 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 1492gets 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, 1495or 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 1501gets a dialog item window handle for an item of type $type of $dlgHwnd 1502relative to $relativeHwnd, which is descendant of $dlgHwnd. 1503$relativeHwnd may be specified if $type is EDI_FIRSTTABITEM or 1504EDI_LASTTABITEM. 1505 1506The return is always an immediate child of hwndDlg, even if hwnd is 1507not an immediate child window. $type may be 1508 1509=over 1510 1511=item EDI_FIRSTGROUPITEM 1512 1513First item in the same group. 1514 1515=item EDI_FIRSTTABITEM 1516 1517First item in dialog with style WS_TABSTOP. hwnd is ignored. 1518 1519=item EDI_LASTGROUPITEM 1520 1521Last item in the same group. 1522 1523=item EDI_LASTTABITEM 1524 1525Last item in dialog with style WS_TABSTOP. hwnd is ignored. 1526 1527=item EDI_NEXTGROUPITEM 1528 1529Next item in the same group. Wraps around to beginning of group when 1530the end of the group is reached. 1531 1532=item EDI_NEXTTABITEM 1533 1534Next item with style WS_TABSTOP. Wraps around to beginning of dialog 1535item list when end is reached. 1536 1537=item EDI_PREVGROUPITEM 1538 1539Previous item in the same group. Wraps around to end of group when the 1540start of the group is reached. For information on the WS_GROUP style, 1541see Window Styles. 1542 1543=item EDI_PREVTABITEM 1544 1545Previous item with style WS_TABSTOP. Wraps around to end of dialog 1546item list when beginning is reached. 1547 1548=back 1549 1550=item DesktopWindow() 1551 1552gets the actual window handle of the PM desktop; most APIs accept the 1553pseudo-handle C<HWND_DESKTOP> instead. Keep in mind that the WPS 1554desktop (one with WindowText() being C<"Desktop">) is a different beast?! 1555 1556=item TopLevel($hwnd) 1557 1558gets the toplevel window of $hwnd. 1559 1560=item ResetWinError() 1561 1562Resets $^E. One may need to call it before the C<Win*>-class APIs which may 1563return 0 during normal operation. In such a case one should check both 1564for return value being zero and $^E being non-zero. The following APIs 1565do ResetWinError() themselves, thus do not need an explicit one: 1566 1567 WindowPtr 1568 WindowULong 1569 WindowUShort 1570 WindowTextLength 1571 ActiveWindow 1572 PostMsg 1573 1574This 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 1584gets 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 1598gets the content of the clipboard. An optional argument is the format 1599of the data in the clipboard (defaults to C<CF_TEXT>). May croak with error 1600C<PMERR_INVALID_HWND> if no data of given $fmt is present. 1601 1602Note that the usual convention is to have clipboard data with 1603C<"\r\n"> as line separators. This function will only work with clipboard 1604data types which are delimited by C<"\0"> byte (not included in the result). 1605 1606=item ClipbrdText_2byte 1607 1608Same as ClipbrdText(), but will only work with clipboard 1609data types which are collection of C C<shorts> delimited by C<0> short 1610(not included in the result). 1611 1612=item ClipbrdTextUCS2le 1613 1614Same as ClipbrdText_2byte(), but will assume that the shorts represent 1615an Unicode string in I<UCS-2le> format (little-endian 2-byte representation 1616of Unicode), and will provide the result in Perl internal C<utf8> format 1617(one short of input represents one Perl character). 1618 1619Note 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 1623sets the text content of the clipboard after removing old contents. Unless the 1624optional argument $no_convert_nl is TRUE, will convert newlines to C<"\r\n">. Another optional 1625argument $fmt is the format of the data in the clipboard (should be an 1626atom, defaults to C<CF_TEXT>). Other arguments are as for C<ClipbrdData_set>. 1627Croaks on failure. 1628 1629=item ClipbrdFmtInfo( [$fmt, [ $hab ] ]) 1630 1631returns the $fmtInfo flags set by the application which filled the 1632format $fmt of the clipboard. $fmt defaults to C<CF_TEXT>. 1633 1634=item ClipbrdOwner( [ $hab ] ) 1635 1636Returns window handle of the current clipboard owner. 1637 1638=item ClipbrdViewer( [ $hab ] ) 1639 1640Returns window handle of the current clipboard viewer. 1641 1642=item ClipbrdData( [$fmt, [ $hab ] ]) 1643 1644Returns a handle to clipboard data of the given format as an integer. 1645Format defaults to C<CF_TEXT> (in this case the handle is a memory address). 1646 1647Clipboard should be opened before calling this function. May croak with error 1648C<PMERR_INVALID_HWND> if no data of given $fmt is present. 1649 1650The result should not be used after clipboard is closed. Hence a return handle 1651of type C<CLI_POINTER> may need to be converted to a string and stored for 1652future usage. Use MemoryRegionSize() to get a high estimate on the length 1653of region addressed by this pointer; the actual length inside this region 1654should be obtained by knowing particular format of data. E.g., it may be 16550-byte terminated for string types, or 0-short terminated for wide-char string 1656types. 1657 1658=item OpenClipbrd( [ $hab ] ) 1659 1660claim read access to the clipboard. May need a message queue to operate. 1661May block until other processes finish dealing with clipboard. 1662 1663=item CloseClipbrd( [ $hab ] ) 1664 1665Allow other processes access to clipboard. 1666Clipboard should be opened before calling this function. 1667 1668=item ClipbrdData_set($data, [$convert_nl, [$fmt, [$fmtInfo, [ $hab] ] ] ] ) 1669 1670Sets the clipboard data of format given by atom $fmt. Format defaults to 1671CF_TEXT. 1672 1673$fmtInfo should declare what type of handle $data is; it should be either 1674C<CFI_POINTER>, or C<CFI_HANDLE> (possibly qualified by C<CFI_OWNERFREE> 1675and C<CFI_OWNERDRAW> flags). It defaults to C<CFI_HANDLE> for $fmt being 1676standard bitmap, metafile, and palette (undocumented???) formats; 1677otherwise defaults to C<CFI_POINTER>. If format is C<CFI_POINTER>, $data 1678should contain the string to copy to clipboard; otherwise it should be an 1679integer handle. 1680 1681If $convert_nl is TRUE (the default), C<"\n"> in $data are converted to 1682C<"\r\n"> pairs if $fmt is C<CFI_POINTER> (as is the convention for text 1683format of the clipboard) unless they are already in such a pair. 1684 1685=item _ClipbrdData_set($data, [$fmt, [$fmtInfo, [ $hab] ] ] ) 1686 1687Sets the clipboard data of format given by atom $fmt. Format defaults to 1688CF_TEXT. $data should be an address (in givable unnamed shared memory which 1689should not be accessed or manipulated after this call) or a handle in a form 1690of an integer. 1691 1692$fmtInfo has the same semantic as for ClipbrdData_set(). 1693 1694=item ClipbrdOwner_set( $hwnd, [ $hab ] ) 1695 1696Sets window handle of the current clipboard owner (window which gets messages 1697when content of clipboard is retrieved). 1698 1699=item ClipbrdViewer_set( $hwnd, [ $hab ] ) 1700 1701Sets window handle of the current clipboard owner (window which gets messages 1702when content of clipboard is changed). 1703 1704=item ClipbrdFmtNames() 1705 1706Returns list of names of formats currently available in the clipboard. 1707 1708=item ClipbrdFmtAtoms() 1709 1710Returns list of atoms of formats currently available in the clipboard. 1711 1712=item EnumClipbrdFmts($fmt [, $hab]) 1713 1714Low-level access to the list of formats currently available in the clipboard. 1715Returns the atom for the format of clipboard after $fmt. If $fmt is 0, returns 1716the 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 1725Clipboard should be opened before calling this function. May croak if 1726no format is present. 1727 1728=item EmptyClipbrd( [ $hab ] ) 1729 1730Remove all the data handles in the clipboard. croak()s on failure. 1731Clipboard should be opened before calling this function. 1732 1733Recommended before assigning a value to clipboard to remove extraneous 1734formats 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 1739the largest continuous region of memory belonging to the same memory object 1740as $addr, and having the same memory flags as $addr. $flags is the value of 1741the memory flag of $addr (see docs of DosQueryMem(3) for details). If 1742optional argument $size_lim is given, the search is restricted to the region 1743this many bytes long (after $addr). 1744 1745($addr and $size are rounded so that all the memory pages containing 1746the region are inspected.) Optional argument $interrupt (defaults to 1) 1747specifies whether region scan should be interruptible by signals. 1748 1749=back 1750 1751Use class C<OS2::localClipbrd> to ensure that clipboard is closed even if 1752the code in the block made a non-local exit. 1753 1754See the L</OS2::localMorphPM, OS2::localFlashWindow, and OS2::localClipbrd classes> 1755 1756=head2 Control of the PM atom tables 1757 1758Low-level methods to access the atom table(s). $atomtable defaults to 1759the SystemAtomTable(). 1760 1761=over 1762 1763=item AddAtom($name, [$atomtable]) 1764 1765Returns the atom; increments the use count unless $name is a name of an 1766integer atom. 1767 1768=item FindAtom($name, [$atomtable]) 1769 1770Returns the atom if it exists, 0 otherwise (actually, croaks). 1771 1772=item DeleteAtom($name, [$atomtable]) 1773 1774Decrements the use count unless $name is a name of an integer atom. 1775When 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 1780Returns the name of the atom. Integer atoms have names of format C<"#ddddd"> 1781of variable length up to 7 chars. 1782 1783=item AtomLength($atom, [$atomtable]) 1784 1785Returns the length of the name of the atom. Return of 0 means that no 1786such atom exists (but usually croaks in such a case). 1787 1788Integer atoms always return length 6. 1789 1790=item AtomUsage($name, [$atomtable]) 1791 1792Returns the usage count of the atom. 1793 1794=item SystemAtomTable() 1795 1796Returns central atom table accessible to any process. 1797 1798=item CreateAtomTable( [ $initial, [ $buckets ] ] ) 1799 1800Returns new per-process atom table. See docs for WinCreateAtomTable(3). 1801 1802=item DestroyAtomTable($atomtable) 1803 1804Dispose 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 1815Audible alarm of type $type (defaults to C<WA_ERROR=2>). Other useful 1816values are C<WA_WARNING=0>, C<WA_NOTE=1>. (What is C<WA_CDEFALARMS=3>???) 1817 1818The duration and frequency of the alarms can be changed by the 1819OS2::SysValues_set(). The alarm frequency is defined to be in the range 0x0025 1820through 0x7FFF. The alarm is not generated if system value SV_ALARM is set 1821to FALSE. The alarms are dependent on the device capability. 1822 1823=item FlashWindow($hwnd, $doFlash) 1824 1825Starts/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 1828Example (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 1837Since flashing window persists even when application ends, it is very 1838important to protect the switching off flashing from non-local exits. Use 1839the class C<OS2::localFlashWindow> for this. Creating the object of this 1840class starts flashing the window until the object is destroyed. The above 1841example becomes: 1842 1843 print STDERR "Press ENTER!\n"; 1844 { my $flash = OS2::localFlashWindow->new( process_hwnd ); 1845 <>; 1846 } 1847 1848B<Notes from IBM docs:> Flashing a window brings the user's attention to a 1849window that is not the active window, where some important message or dialog 1850must be seen by the user. 1851 1852Note: It should be used only for important messages, for example, where some 1853component of the system is failing and requires immediate attention to avoid 1854damage. 1855 1856=item MessageBox($text, [ $title, [$flags, ...] ]) 1857 1858Shows a simple messagebox with (optional) icon, message $text, and one or 1859more buttons to dismiss the box. Returns the indicator of which action was 1860taken by the user. If optional argument $title is not given, 1861the 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> 1863button, I<INFO>-style icon, and a border for moving. Flags should be 1864a 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 1906With C<MB_MOVEABLE> the message box is displayed with a title bar and a 1907system menu, which shows only the Move, Close, and Task Manager choices, 1908which can be selected either by use of the pointing device or by 1909accelerator keys. If the user selects Close, the message box is removed 1910and the usResponse is set to C<MBID_CANCEL>, whether or not a cancel button 1911existed within the message box. 1912 1913C<Esc> key dismisses the dialogue only if C<CANCEL> button is present; the 1914return value is C<MBID_CANCEL>. 1915 1916With C<MB_APPLMODAL> the owner of the dialogue is disabled; therefore, do not 1917specify the owner as the parent if this option is used. 1918 1919Additionally, 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 1926Other optional arguments: $parent window, $owner_window, $helpID (used with 1927C<WM_HELP> message if C<MB_HELP> style is given). 1928 1929The 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 1942B<BUGS???> keyboard transversal by pressing C<TAB> key does not work. 1943Do not appear in window list, so may be hard to find if covered by other 1944windows. 1945 1946=item _MessageBox($text, [ $title, [$flags, ...] ]) 1947 1948Similar to MessageBox(), but the default $title does not depend on the name 1949of the script. 1950 1951=item MessageBox2($text, [ $buttons_Icon, [$title, ...] ]) 1952 1953Similar to MessageBox(), but allows more flexible choice of button texts 1954and the icon. $buttons_Icon is a reference to an array with information about 1955buttons and the icon to use; the semantic of this array is the same as 1956for argument list of process_MB2_INFO(). The default value will show 1957one button B<Dismiss> which will return C<0x1000>. 1958 1959Other optional arguments are the same as for MessageBox(). 1960 1961B<NOTE.> Remark about C<MBID_CANCEL> in presence of C<MB_MOVABLE> is 1962equally applicable to MessageBox() and MessageBox2(). 1963 1964Example: 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 1971will show a messagebox with 1972 1973=over 20 1974 1975=item Title 1976 1977B<Choose a number to print>, 1978 1979=item Text 1980 1981B<Foo prints 100, Bar 101, Baz 102> 1982 1983=item Icon 1984 1985INFORMATION ICON 1986 1987=item Buttons 1988 1989B<Foo>, B<Bar>, B<Baz> 1990 1991=item Default button 1992 1993B<Baz> 1994 1995=item accelerator keys 1996 1997B<F>, B<a>, and B<z> 1998 1999=item return values 2000 2001100, 101, and 102 correspondingly, 2002 2003=back 2004 2005Using 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 2012will show the 22nd system icon as the dialog icon (small folder icon). 2013 2014=item _MessageBox2($text, $buttons_Icon_struct, [$title, ...]) 2015 2016low-level workhorse to implement MessageBox2(). Differs by the default 2017$title, and that $buttons_Icon_struct is required, and is a string with 2018low-level C struct. 2019 2020=item process_MB2_INFO($buttons, [$iconID, [$flags, [$notifyWindow]]]) 2021 2022low-level workhorse to implement MessageBox2(); calculates the second 2023argument of _MessageBox2(). $buttons is a reference 2024to array of button descriptions. $iconID is either an ID of icon for 2025the message box, or a string of the form C<"SP#number">; in the latter case 2026the 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, 2028modality, 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 2036Each button's description takes two elements of the description array, 2037appearance description, and the return value of MessageBox2() if this 2038button is selected. The appearance description is either an array reference 2039of 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) 2041or just $button_Text (with "normal" style). E.g., the list 2042 2043 Foo => 100, Bar => 101, [Baz] => 102 2044 2045will show three buttons B<Foo>, B<Bar>, B<Baz> with B<Baz> being the default 2046button; pressing buttons return 100, 101, or 102 correspondingly. 2047 2048In particular, exactly one button should have C<BS_DEFAULT> style (e.g., 2049given as C<[$button_Name]>); otherwise the message box will not have keyboard 2050focus! (The only exception is the case of one button; then C<[$button_Name]> 2051can be replaced (for convenience) with plain C<$button_Name>.) 2052 2053If text of the button contains character C<~>, the following character becomes 2054the keyboard accelerator for this button. One can also get the handle 2055of system icons directly, so C<'SP#22'> can be replaced by 2056C<OS2::Process::get_pointer(22)>; see also C<SPTR_*> constants. 2057 2058B<NOTE> With C<MB_NONMODAL> the program continues after displaying the 2059nonmodal message box. The message box remains visible until the owner window 2060destroys it. Two notification messages, WM_MSGBOXINIT and WM_MSGBOXDISMISS, 2061are used to support this non-modality. 2062 2063=item LoadPointer($id, [$module, [$hwnd]]) 2064 2065Loads 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 2067executable; otherwise from a DLL with the handle $module. 2068 2069The pointer is owned by the process, and is destroyed by 2070DestroyPointer() call, or when the process terminates. 2071 2072=item SysPointer($id, [$copy, [$hwnd]]) 2073 2074Gets a handle for (a copy of) the system pointer $id (the value should 2075be one of C<SPTR_*> constants). A copy is made if $copy is TRUE (the 2076default). $hwnd defaults to C<HWND_DESKTOP>. 2077 2078=item get_pointer($id, [$copy, [$hwnd]]) 2079 2080Gets (and caches) a copy of the system pointer. 2081 2082=back 2083 2084=head2 Constants used by OS/2 APIs 2085 2086Function C<os2constant($name)> returns the value of the constant; to 2087decrease the memory usage of this package, only the constants used by 2088APIs called by Perl functions in this package are made available. 2089 2090For direct access, see also the L<"EXPORTS"> section; the latter way 2091may also provide some performance advantages, since the value of the 2092constant is cached. 2093 2094=head1 OS2::localMorphPM, OS2::localFlashWindow, and OS2::localClipbrd classes 2095 2096The class C<OS2::localMorphPM> morphs the process to PM for the duration of 2097the given scope. 2098 2099 { 2100 my $h = OS2::localMorphPM->new(0); 2101 # Do something 2102 } 2103 2104The argument has the same meaning as one to OS2::MorphPM(). Calls can 2105nest with internal ones being NOPs. 2106 2107Likewise, C<OS2::localClipbrd> class opens the clipboard for the duration 2108of the current scope; if TRUE optional argument is given, it would not 2109morph 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 2116C<OS2::localFlashWindow> behaves similarly; see 2117L<FlashWindow($hwnd, $doFlash)>. 2118 2119=head1 EXAMPLES 2120 2121The test suite for this module contains an almost comprehensive collection 2122of examples of using the API of this module. 2123 2124=head1 TODO 2125 2126Add 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 2152Document: InvalidateRect, 2153CreateFrameControls, kbdChar, kbdhChar, 2154kbdStatus, _kbdStatus_set, kbdhStatus, kbdhStatus_set, 2155vioConfig, viohConfig, vioMode, viohMode, viohMode_set, _vioMode_set, 2156_vioState, _vioState_set, vioFont, vioFont_set 2157 2158Test: SetWindowULong/Short/Ptr, SetWindowBits. InvalidateRect, 2159CreateFrameControls, ClipbrdOwner_set, ClipbrdViewer_set, _ClipbrdData_set, 2160Alarm, FlashWindow, _MessageBox, MessageBox, _MessageBox2, MessageBox2, 2161LoadPointer, SysPointer, kbdChar, kbdhChar, kbdStatus, _kbdStatus_set, 2162kbdhStatus, kbdhStatus_set, vioConfig, viohConfig, vioMode, viohMode, 2163viohMode_set, _vioMode_set, _vioState, _vioState_set, vioFont, vioFont_set 2164 2165Implement 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 2326Why C<hWindowPos DesktopWindow> gives C<< behind => HWND_TOP >>? 2327 2328=head1 $^E 2329 2330the majority of the APIs of this module set $^E on failure (no matter 2331whether they die() on failure or not). By the semantic of PM API 2332which returns something other than a boolean, it is impossible to 2333distinguish failure from a "normal" 0-return. In such cases C<$^E == 23340> indicates an absence of error. 2335 2336=head1 EXPORTS 2337 2338In addition to symbols described above, the following constants (available 2339also via module C<OS2::Process::Const>) are exportable. Note that these 2340symbols live in package C<OS2::Process::Const>, they are not available 2341by 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 2369whether a given API dies or returns FALSE/empty-list on error may be 2370confusing. This may change in the future. 2371 2372=head1 AUTHOR 2373 2374Andreas Kaiser <ak@ananke.s.bawue.de>, 2375Ilya Zakharevich <ilya@math.ohio-state.edu>. 2376 2377=head1 SEE ALSO 2378 2379C<spawn*>() system calls, L<OS2::Proc> and L<OS2::WinObject> modules. 2380 2381=cut 2382