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