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