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