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