summaryrefslogtreecommitdiff
path: root/os2
diff options
context:
space:
mode:
authorIlya Zakharevich <ilya@math.berkeley.edu>2002-02-14 22:56:24 -0500
committerAbhijit Menon-Sen <ams@wiw.org>2002-02-15 08:42:55 +0000
commit30500b05e0cd7c98f3f3ddb34d343729aab7b8f7 (patch)
tree6a93990dc0eba6e0f24b71fc429956915e61ea5f /os2
parent59ecbafad1ed6a69b6ea56aa837f49504fd5051a (diff)
downloadperl-30500b05e0cd7c98f3f3ddb34d343729aab7b8f7.tar.gz
OS/2 tests and more
Message-Id: <20020215035624.A16467@math.ohio-state.edu> p4raw-link: @14577 on //depot/perl: 0ad5258ff3f3328f321188cbb4fcd6a74b365431 p4raw-id: //depot/perl@14705
Diffstat (limited to 'os2')
-rw-r--r--os2/OS2/Process/Makefile.PL2
-rw-r--r--os2/OS2/Process/Process.pm591
-rw-r--r--os2/OS2/Process/Process.xs359
-rw-r--r--os2/OS2/Process/t/os2_process.t504
-rw-r--r--os2/OS2/Process/t/os2_process_kid.t64
-rw-r--r--os2/OS2/Process/t/os2_process_text.t52
-rw-r--r--os2/os2.c109
-rw-r--r--os2/os2_base.t52
-rw-r--r--os2/os2ish.h74
9 files changed, 1558 insertions, 249 deletions
diff --git a/os2/OS2/Process/Makefile.PL b/os2/OS2/Process/Makefile.PL
index c1417579c7..6a59d1f013 100644
--- a/os2/OS2/Process/Makefile.PL
+++ b/os2/OS2/Process/Makefile.PL
@@ -32,7 +32,7 @@ sub create_constants {
'--skip-strict', '--skip-warnings', # likewise
'--skip-ppport', # will not work without dynaloading.
# Most useful for OS2::Process:
- '-M^(HWND|WM|SC|SWP|WC|PROG|QW|EDI|WS)_',
+ '-M^(HWND|WM|SC|SWP|WC|PROG|QW|EDI|WS|QWS|QWP|QWL|FF|FI|LS|FS|FCF|BS|MS|TBM|CF|CFI|FID)_',
'-F', '-DINCL_NLS -DINCL_BASE -DINCL_PM', # Define more symbols
'os2emx.h' # EMX version of OS/2 API
and warn("Can't build module with contants, falling back to no constants"),
diff --git a/os2/OS2/Process/Process.pm b/os2/OS2/Process/Process.pm
index 30154302d3..29e4d9b433 100644
--- a/os2/OS2/Process/Process.pm
+++ b/os2/OS2/Process/Process.pm
@@ -1,24 +1,33 @@
package OS2::localMorphPM;
+# use strict;
-sub new { my ($c,$f) = @_; OS2::MorphPM($f); bless [shift], $c }
-sub DESTROY { OS2::UnMorphPM(shift->[0]) }
+sub new {
+ my ($c,$f) = @_;
+ OS2::MorphPM($f);
+ # print STDERR ">>>>>\n";
+ bless [$f], $c
+}
+sub DESTROY {
+ # print STDERR "<<<<<\n";
+ OS2::UnMorphPM(shift->[0])
+}
package OS2::Process;
BEGIN {
require Exporter;
- require DynaLoader;
+ require XSLoader;
#require AutoLoader;
- @ISA = qw(Exporter DynaLoader);
- $VERSION = "1.0";
- bootstrap OS2::Process;
+ our @ISA = qw(Exporter);
+ our $VERSION = "1.0";
+ XSLoader::load('OS2::Process', $VERSION);
}
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
-@EXPORT = qw(
+our @EXPORT = qw(
P_BACKGROUND
P_DEBUG
P_DEFAULT
@@ -62,15 +71,24 @@ BEGIN {
process_hentries
change_entry
change_entryh
+ process_hwnd
Title_set
Title
+ winTitle_set
+ winTitle
+ swTitle_set
+ bothTitle_set
WindowText
WindowText_set
WindowPos
WindowPos_set
+ hWindowPos
+ hWindowPos_set
WindowProcess
SwitchToProgram
+ DesktopWindow
ActiveWindow
+ ActiveWindow_set
ClassName
FocusWindow
FocusWindow_set
@@ -94,26 +112,46 @@ BEGIN {
WindowFromId
WindowFromPoint
EnumDlgItem
+ EnableWindow
+ EnableWindowUpdate
+ IsWindowEnabled
+ IsWindowVisible
+ IsWindowShowing
+ WindowPtr
+ WindowULong
+ WindowUShort
+ SetWindowBits
+ SetWindowPtr
+ SetWindowULong
+ SetWindowUShort
get_title
set_title
);
+our @EXPORT_OK = qw(
+ ResetWinError
+ MPFROMSHORT
+ MPVOID
+ MPFROMCHAR
+ MPFROM2SHORT
+ MPFROMSH2CH
+ MPFROMLONG
+);
+
+our $AUTOLOAD;
sub AUTOLOAD {
# This AUTOLOAD is used to 'autoload' constants from the constant()
# XS function. If a constant is not found then control is passed
# to the AUTOLOAD in AutoLoader.
- local($constname);
- ($constname = $AUTOLOAD) =~ s/.*:://;
- $val = constant($constname, @_ ? $_[0] : 0);
+ (my $constname = $AUTOLOAD) =~ s/.*:://;
+ my $val = constant($constname, @_ ? $_[0] : 0);
if ($! != 0) {
if ($! =~ /Invalid/ || $!{EINVAL}) {
- $AutoLoader::AUTOLOAD = $AUTOLOAD;
- goto &AutoLoader::AUTOLOAD;
- }
- else {
- ($pack,$file,$line) = caller;
+ die "Unsupported function $AUTOLOAD"
+ } else {
+ my ($pack,$file,$line) = caller;
die "Your vendor has not defined OS2::Process macro $constname, used at $file line $line.
";
}
@@ -122,6 +160,29 @@ sub AUTOLOAD {
goto &$AUTOLOAD;
}
+sub const_import {
+ require OS2::Process::Const;
+ my $sym = shift;
+ my ($err, $val) = OS2::Process::Const::constant($sym);
+ die $err if $err;
+ my $p = caller(1);
+
+ # no strict;
+
+ *{"$p\::$sym"} = sub () { $val };
+ (); # needed by import()
+}
+
+sub import {
+ my $class = shift;
+ my $ini = @_;
+ @_ = ($class,
+ map {
+ /^(HWND|WM|SC|SWP|WC|PROG|QW|EDI|WS|QWS|QWP|QWL|FF|FI|LS|FS|FCF|BS|MS|TBM|CF|CFI|FID)_/ ? const_import($_) : $_
+ } @_);
+ goto &Exporter::import if @_ > 1 or $ini == 0;
+}
+
# Preloaded methods go here.
sub Title () { (process_entry())[0] }
@@ -134,7 +195,7 @@ sub swTitle_set_sw {
change_entry(@sw);
}
-sub swTitle_set {
+sub swTitle_set ($) {
my (@sw) = process_entry();
swTitle_set_sw(shift, @sw);
}
@@ -145,19 +206,25 @@ sub winTitle_set_sw {
WindowText_set $sw[1], $title;
}
-sub winTitle_set {
+sub winTitle_set ($) {
my (@sw) = process_entry();
winTitle_set_sw(shift, @sw);
}
-sub bothTitle_set {
+sub winTitle () {
+ my (@sw) = process_entry();
+ my $h = OS2::localMorphPM->new(0);
+ WindowText $sw[1];
+}
+
+sub bothTitle_set ($) {
my (@sw) = process_entry();
my $t = shift;
winTitle_set_sw($t, @sw);
swTitle_set_sw($t, @sw);
}
-sub Title_set {
+sub Title_set ($) {
my $t = shift;
return 1 if sesmgr_title_set($t);
return 0 unless $^E == 372;
@@ -179,6 +246,7 @@ sub swentry_hexpand ($) {
}
sub process_hentry { swentry_hexpand(process_swentry(@_)) }
+sub process_hwnd { process_hentry()->{owner_hwnd} }
my $swentry_size = swentry_size();
@@ -214,14 +282,53 @@ sub change_entryh ($) {
# Massage entries into the same order as WindowPos_set:
sub WindowPos ($) {
- my ($fl, $w, $h, $x, $y, $behind, $hwnd, @rest)
+ my ($fl, $h, $w, $y, $x, $behind, $hwnd, @rest)
= unpack 'L l4 L4', WindowSWP(shift);
($x, $y, $fl, $w, $h, $behind, @rest);
}
-sub ChildWindows ($) {
+# Put them into a hash
+sub hWindowPos ($) {
+ my %h;
+ @h{ qw(flags height width y x behind hwnd reserved1 reserved2) }
+ = unpack 'L l4 L4', WindowSWP(shift);
+ \%h;
+}
+
+my @SWP_keys = ( [qw(width height)], # SWP_SIZE=1
+ [qw(x y)], # SWP_MOVE=2
+ [qw(behind)] ); # SWP_ZORDER=3
+my %SWP_def;
+@SWP_def{ map @$_, @SWP_keys } = (0) x 20;
+
+# Get them from a hash
+sub hWindowPos_set ($$) {
+ my $hash = shift;
+ my $hwnd = (@_ ? shift : $hash->{hwnd} );
+ my $flags;
+ if (exists $hash->{flags}) {
+ $flags = $hash->{flags};
+ } else { # Set flags according to existing keys in $hash
+ $flags = 0;
+ for my $bit (0..2) {
+ exists $hash->{$_} and $flags |= (1<<$bit) for @{$SWP_keys[$bit]};
+ }
+ }
+ for my $bit (0..2) { # Check for required keys
+ next unless $flags & (1<<$bit);
+ exists $hash->{$_}
+ or die sprintf "key $_ required for flags=%#x", $flags
+ for @{$SWP_keys[$bit]};
+ }
+ my %h = (%SWP_def, flags => $flags, %$hash); # Avoid warnings
+ my ($x, $y, $fl, $w, $h, $behind) = @h{ qw(x y flags width height behind) };
+ WindowPos_set($hwnd, $x, $y, $fl, $w, $h, $behind);
+}
+
+sub ChildWindows (;$) {
+ my $hm = OS2::localMorphPM->new(0);
my @kids;
- my $h = BeginEnumWindows shift;
+ my $h = BeginEnumWindows(@_ ? shift : 1); # HWND_DESKTOP
my $w;
push @kids, $w while $w = GetNextWindow $h;
EndEnumWindows $h;
@@ -554,11 +661,16 @@ changes a process entry, arguments are the same as process_entry() returns.
Similar to change_entry(), but takes a hash reference as an argument.
+=item process_hwnd()
+
+returns the C<owner_hwnd> of the process entry (for VIO windowed processes
+this is the frame window of the session).
+
=item Title()
-returns a title of the current session. (There is no way to get this
-info in non-standard Session Managers, this implementation is a
-shortcut via process_entry().)
+returns the text of the task switch menu entry of the current session.
+(There is no way to get this info in non-standard Session Managers. This
+implementation is a shortcut via process_entry().)
=item C<Title_set(newtitle)>
@@ -569,8 +681,29 @@ This is a limitation of OS/2, in such a case $^E is set to 372 (type
help 372
for a funny - and wrong - explanation ;-). In such cases a
-direct-manipulation of low-level entries is used. Keep in mind that
-some versions of OS/2 leak memory with such a manipulation.
+direct-manipulation of low-level entries is used (same as bothTitle_set()).
+Keep in mind that some versions of OS/2 leak memory with such a manipulation.
+
+=item winTitle()
+
+returns text of the titlebar of the current process' window.
+
+=item C<winTitle_set(newtitle)>
+
+sets text of the titlebar of the current process' window. The change does not
+affect the text of the switch entry of the current window.
+
+=item C<swTitle_set(newtitle)>
+
+sets text of the task switch menu entry of the current process' window. [There
+is no API to query this title.] Does it via SwitchEntry interface,
+not Session manager interface. The change does not affect the text of the
+titlebar of the current window.
+
+=item C<bothTitle_set(newtitle)>
+
+sets text of the titlebar and task switch menu of the current process' window
+via direct manipulation of the windows' texts.
=item C<SwitchToProgram($sw_entry)>
@@ -614,42 +747,61 @@ important restriction on ownership is that owner should be created by
the same thread as the owned thread, so they engage in the same
message queue.]
-Windows may be in many different state: Focused, Activated (=Windows
-in the I<parent/child> tree between the root and the window with
-focus; usually indicate such "active state" by titlebar highlights),
-Enabled/Disabled (this influences *an ability* to receive user input
-(be focused?), and may change appearance, as for enabled/disabled
-buttons), Visible/Hidden, Minimized/Maximized/Restored, Modal, etc.
+Windows may be in many different state: Focused (take keyboard events) or not,
+Activated (=Frame windows in the I<parent/child> tree between the root and
+the window with the focus; usually indicate such "active state" by titlebar
+highlights, and take mouse events) or not, Enabled/Disabled (this influences
+the ability to update the graphic, and may change appearance, as for
+enabled/disabled buttons), Visible/Hidden, Minimized/Maximized/Restored, Modal
+or not, etc.
+
+The APIs below all die() on error with the message being $^E.
=over
=item C<WindowText($hwnd)>
-gets "a text content" of a window.
+gets "a text content" of a window. Requires (morphing to) PM.
=item C<WindowText_set($hwnd, $text)>
-sets "a text content" of a window.
+sets "a text content" of a window. Requires (morphing to) PM.
-=item C<WindowPos($hwnd)>
+=item C<($x, $y, $flags, $width, $height, $behind, @rest) = WindowPos($hwnd)>
gets window position info as 8 integers (of C<SWP>), in the order suitable
-for WindowPos_set(): $x, $y, $fl, $w, $h, $behind, @rest.
+for WindowPos_set(). @rest is marked as "reserved" in PM docs. $flags
+is a combination of C<SWP_*> constants.
+
+=item C<$hash = hWindowPos($hwnd)>
+
+gets window position info as a hash reference; the keys are C<flags width
+height x y behind hwnd reserved1 reserved2>.
-=item C<WindowPos_set($hwnd, $x, $y, $flags = SWP_MOVE, $wid = 0, $h = 0, $behind = HWND_TOP)>
+Example:
+
+ exit unless $hash->{flags} & SWP_MAXIMIZE; # Maximized
+
+=item C<WindowPos_set($hwnd, $x, $y, $flags = SWP_MOVE, $width = 0, $height = 0, $behind = HWND_TOP)>
Set state of the window: position, size, zorder, show/hide, activation,
minimize/maximize/restore etc. Which of these operations to perform
is governed by $flags.
-=item C<WindowProcess($hwnd)>
+=item C<hWindowPos_set($hash, [$hwnd])>
-gets I<PID> and I<TID> of the process associated to the window.
+Same as C<WindowPos_set>, but takes the position from keys C<fl width height
+x y behind hwnd> of the hash referenced by $hash. If $hwnd is explicitly
+specified, it overrides C<$hash->{hwnd}>. If $hash->{flags} is not specified,
+it is calculated basing on the existing keys of $hash. Requires (morphing to) PM.
-=item ActiveWindow([$parentHwnd])
+Example:
-gets the active subwindow's handle for $parentHwnd or desktop.
-Returns FALSE if none.
+ hWindowPos_set {flags => SWP_MAXIMIZE}, $hwnd; # Maximize
+
+=item C<($pid, $tid) = WindowProcess($hwnd)>
+
+gets I<PID> and I<TID> of the process associated to the window.
=item C<ClassName($hwnd)>
@@ -662,51 +814,102 @@ constant.
=item FocusWindow()
-returns the handle of the focus window. Optional argument for specifying the desktop
-to use.
+returns the handle of the focus window. Optional argument for specifying
+the desktop to use.
=item C<FocusWindow_set($hwnd)>
set the focus window by handle. Optional argument for specifying the desktop
to use. E.g, the first entry in program_entries() is the C<Ctrl-Esc> list.
-To show it
+To show an application, use either one of
- WinShowWindow( wlhwnd, TRUE );
- WinSetFocus( HWND_DESKTOP, wlhwnd );
- WinSwitchToProgram(wlhswitch);
+ WinShowWindow( $hwnd, 1 );
+ SetFocus( $hwnd );
+ SwitchToProgram($switch_handle);
+(Which work with alternative focus-to-front policies?) Requires (morphing to) PM.
+
+=item C<ActiveWindow([$parentHwnd])>
+
+gets the active subwindow's handle for $parentHwnd or desktop.
+Returns FALSE if none.
+
+=item C<ActiveWindow_set($hwnd, [$parentHwnd])>
+
+sets the active subwindow's handle for $parentHwnd or desktop. Requires (morphing to) PM.
=item C<ShowWindow($hwnd [, $show])>
Set visible/hidden flag of the window. Default: $show is TRUE.
+=item C<EnableWindowUpdate($hwnd [, $update])>
+
+Set window visibility state flag for the window for subsequent drawing.
+No actual drawing is done at this moment. Use C<ShowWindow($hwnd, $state)>
+when redrawing is needed. While update is disabled, changes to the "window
+state" do not change the appearence of the window. Default: $update is TRUE.
+
+(What is manipulated is the bit C<WS_VISIBLE> of the window style.)
+
+=item C<EnableWindow($hwnd [, $enable])>
+
+Set the window enabled state. Default: $enable is TRUE.
+
+Results in C<WM_ENABLED> message sent to the window. Typically, this
+would change the appearence of the window. If at the moment of disabling
+focus is in the window (or a descendant), focus is lost (no focus anywhere).
+If focus is needed, it can be reassigned explicitly later.
+
+=item IsWindowEnabled(), IsWindowVisible(), IsWindowShowing()
+
+these functions take $hwnd as an argument. IsWindowEnabled() queries
+the state changed by EnableWindow(), IsWindowVisible() the state changed
+by ShowWindow(), IsWindowShowing() is true if there is a part of the window
+visible on the screen.
+
=item C<PostMsg($hwnd, $msg, $mp1, $mp2)>
post message to a window. The meaning of $mp1, $mp2 is specific for each
-message id $msg, they default to 0. E.g., in C it is done similar to
+message id $msg, they default to 0. E.g.,
+
+ use OS2::Process qw(:DEFAULT WM_SYSCOMMAND WM_CONTEXTMENU
+ WM_SAVEAPPLICATION WM_QUIT WM_CLOSE
+ SC_MAXIMIZE SC_RESTORE);
+ $hwnd = process_hentry()->{owner_hwnd};
+ # Emulate choosing `Restore' from the window menu:
+ PostMsg $hwnd, WM_SYSCOMMAND, MPFROMSHORT(SC_RESTORE); # Not immediate
+
+ # Emulate `Show-Contextmenu' (Double-Click-2), two ways:
+ PostMsg ActiveWindow, WM_CONTEXTMENU;
+ PostMsg FocusWindow, WM_CONTEXTMENU;
+
+ /* Emulate `Close' */
+ PostMsg ActiveWindow, WM_CLOSE;
+
+ /* Same but with some "warnings" to the application */
+ $hwnd = ActiveWindow;
+ PostMsg $hwnd, WM_SAVEAPPLICATION;
+ PostMsg $hwnd, WM_CLOSE;
+ PostMsg $hwnd, WM_QUIT;
- /* Emulate `Restore' */
- WinPostMsg(SwitchBlock.tswe[i].swctl.hwnd, WM_SYSCOMMAND,
- MPFROMSHORT(SC_RESTORE), 0);
+In fact, MPFROMSHORT() may be omited above.
- /* Emulate `Show-Contextmenu' (Double-Click-2) */
- hwndParent = WinQueryFocus(HWND_DESKTOP);
- hwndActive = WinQueryActiveWindow(hwndParent);
- WinPostMsg(hwndActive, WM_CONTEXTMENU, MPFROM2SHORT(0,0), MPFROMLONG(0));
+For messages to other processes, messages which take/return a pointer are
+not supported.
- /* Emulate `Close' */
- WinPostMsg(pSWB->aswentry[i].swctl.hwnd, WM_CLOSE, 0, 0);
+=item C<MP*()>
- /* Same but softer: */
- WinPostMsg(hwndactive, WM_SAVEAPPLICATION, 0L, 0L);
- WinPostMsg(hwndactive, WM_CLOSE, 0L, 0L));
- WinPostMsg(hwndactive, WM_QUIT, 0L, 0L));
+The functions MPFROMSHORT(), MPVOID(), MPFROMCHAR(), MPFROM2SHORT(),
+MPFROMSH2CH(), MPFROMLONG() can be used the same way as from C. Use them
+to construct parameters $m1, $m2 to PostMsg().
+
+These functions are not exported by default.
=item C<$eh = BeginEnumWindows($hwnd)>
starts enumerating immediate child windows of $hwnd in z-order. The
enumeration reflects the state at the moment of BeginEnumWindows() calls;
-use IsWindow() to be sure.
+use IsWindow() to be sure. All the functions in this group require (morphing to) PM.
=item C<$kid_hwnd = GetNextWindow($eh)>
@@ -716,10 +919,11 @@ gets the next kid in the list. Gets 0 on error or when the list ends.
End enumeration and release the list.
-=item C<@list = ChildWindows($hwnd)>
+=item C<@list = ChildWindows([$hwnd])>
returns the list of child windows at the moment of the call. Same remark
-as for enumeration interface applies. Example of usage:
+as for enumeration interface applies. Defaults to HWND_DESKTOP.
+Example of usage:
sub l {
my ($o,$h) = @_;
@@ -752,7 +956,7 @@ return a window handle of a child of $hwnd with the given $id.
=item C<WindowFromPoint($x, $y [, $hwndParent [, $descedantsToo]])>
gets a handle of a child of $hwndParent at C<($x,$y)>. If $descedantsToo
-(defaulting to 0) then children of children may be returned too. May return
+(defaulting to 1) then children of children may be returned too. May return
$hwndParent (defaults to desktop) if no suitable children are found,
or 0 if the point is outside the parent.
@@ -809,11 +1013,27 @@ item list when beginning is reached.
=back
+=item ResetWinError()
+
+Resets $^E. One may need to call it before the C<Win*>-class APIs which may
+return 0 during normal operation. In such a case one should check both
+for return value being zero and $^E being non-zero. The following APIs
+do ResetWinError() themselves, thus do not need an explicit one:
+
+ WindowPtr
+ WindowULong
+ WindowUShort
+ WindowTextLength
+ ActiveWindow
+ PostMsg
+
+This function is normally not needed. Not exported by default.
+
=back
=head1 OS2::localMorphPM class
-This class morphs the process to PM for the duration of the given context.
+This class morphs the process to PM for the duration of the given scope.
{
my $h = OS2::localMorphPM->new(0);
@@ -825,23 +1045,199 @@ nest with internal ones being NOPs.
=head1 TODO
-Constants (currently one needs to get them looking in a header file):
+Add tests for:
- HWND_*
- WM_* /* Separate module? */
- SC_*
- SWP_*
- WC_*
- PROG_*
- QW_*
- EDI_*
- WS_*
+ SwitchToProgram
+ ClassName
+ out_codepage
+ out_codepage_set
+ in_codepage
+ in_codepage_set
+ cursor
+ cursor_set
+ screen
+ screen_set
+ process_codepages
+ QueryWindow
+ EnumDlgItem
+ WindowPtr
+ WindowULong
+ WindowUShort
+ SetWindowBits
+ SetWindowPtr
+ SetWindowULong
+ SetWindowUShort
+ my_type
+ file_type
+ scrsize
+ scrsize_set
+
+Document:
+Query/SetWindowULong/Short/Ptr, SetWindowBits.
+
+Implement InvalidateRect,
+CreateFrameControl. ClipbrdFmtInfo, ClipbrdData, OpenClipbrd, CloseClipbrd,
+ClipbrdData_set, EnumClipbrdFmt, EmptyClipbrd. SOMETHINGFROMMR.
+
+
+ >But I wish to change the default button if the user enters some
+ >text into an entryfield. I can detect the entry ok, but can't
+ >seem to get the button to change to default.
+ >
+ >No matter what message I send it, it's being ignored.
+
+ You need to get the style of the buttons using WinQueryWindowULong/QWL_STYLE,
+ set and reset the BS_DEFAULT bits as appropriate and then use
+ WinSetWindowULong/QWL_STYLE to set the button style.
+ Something like this:
+ hwnd1 = WinWindowFromID (hwnd, id1);
+ hwnd2 = WinWindowFromID (hwnd, id2);
+ style1 = WinQueryWindowULong (hwnd1, QWL_STYLE);
+ style2 = WinQueryWindowULong (hwnd2, QWL_STYLE);
+ style1 |= style2 & BS_DEFAULT;
+ style2 &= ~BS_DEFAULT;
+ WinSetWindowULong (hwnd1, QWL_STYLE, style1);
+ WinSetWindowULong (hwnd2, QWL_STYLE, style2);
+
+ > How to do query and change a frame creation flags for existing window?
+
+ Set the style bits that correspond to the FCF_* flag for the frame
+ window and then send a WM_UPDATEFRAME message with the appropriate FCF_*
+ flag in mp1.
+
+ ULONG ulFrameStyle;
+ ulFrameStyle = WinQueryWindowULong( WinQueryWindow(hwnd, QW_PARENT),
+ QWL_STYLE );
+ ulFrameStyle = (ulFrameStyle & ~FS_SIZEBORDER) | FS_BORDER;
+ WinSetWindowULong( WinQueryWindow(hwnd, QW_PARENT),
+ QWL_STYLE,
+ ulFrameStyle );
+ WinSendMsg( WinQueryWindow(hwnd, QW_PARENT),
+ WM_UPDATEFRAME,
+ MPFROMP(FCF_SIZEBORDER),
+ MPVOID );
+
+ If the FCF_* flags you want to change does not have a corresponding FS_*
+ style (i.e. the FCF_* flag corresponds to the presence/lack of a frame
+ control rather than a property of the frame itself) then you create or
+ destroy the appropriate control window using the correct FID_* window
+ identifier and then send the WM_UPDATEFRAME message with the appropriate
+ FCF_* flag in mp1.
+
+ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*
+ | SetFrameBorder() |
+ | Changes a frame window's border to the requested type. |
+ | |
+ | Parameters on entry: |
+ | hwndFrame -> Frame window whose border is to be changed. |
+ | ulBorderStyle -> Type of border to change to. |
+ | |
+ | Returns: |
+ | BOOL -> Success indicator. |
+ | |
+ * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
+ BOOL SetFrameBorder( HWND hwndFrame, ULONG ulBorderType ) {
+ ULONG ulFrameStyle;
+ BOOL fSuccess = TRUE;
+
+ ulFrameStyle = WinQueryWindowULong( hwndFrame, QWL_STYLE );
+
+ switch ( ulBorderType ) {
+ case FS_SIZEBORDER :
+ ulFrameStyle = (ulFrameStyle & ~(FS_DLGBORDER | FS_BORDER))
+ | FS_SIZEBORDER;
+ break;
+
+ case FS_DLGBORDER :
+ ulFrameStyle = (ulFrameStyle & ~(FS_SIZEBORDER | FS_BORDER))
+ | FS_DLGBORDER;
+ break;
+
+ case FS_BORDER :
+ ulFrameStyle = (ulFrameStyle & ~(FS_SIZEBORDER | FS_DLGBORDER))
+ | FS_BORDER;
+ break;
+
+ default :
+ fSuccess = FALSE;
+ break;
+ } // end switch
+
+ if ( fSuccess ) {
+ fSuccess = WinSetWindowULong( hwndFrame, QWL_STYLE, ulFrameStyle );
+
+ if ( fSuccess ) {
+ fSuccess = (BOOL)WinSendMsg( hwndFrame, WM_UPDATEFRAME, 0, 0 );
+ if ( fSuccess )
+ fSuccess = WinInvalidateRect( hwndFrame, NULL, TRUE );
+ }
+ }
+
+ return ( fSuccess );
+
+ } // End SetFrameBorder()
+
+ hwndMenu=WinLoadMenu(hwndParent,NULL,WND_IMAGE);
+ WinSetWindowUShort(hwndMenu,QWS_ID,FID_MENU);
+ ulStyle=WinQueryWindowULong(hwndMenu,QWL_STYLE);
+ WinSetWindowULong(hwndMenu,QWL_STYLE,ulStyle|MS_ACTIONBAR);
+ WinSendMsg(hwndParent,WM_UPDATEFRAME,MPFROMSHORT(FCF_MENU),0L);
+
+ OS/2-windows have another "parent" called the *owner*,
+ which must be set separately - to get a close relationship:
+
+ WinSetOwner (hwndFrameChild, hwndFrameMain);
+
+ Now your child should move with your main window!
+ And always stays on top of it....
+
+ To avoid this, for example for dialogwindows, you can
+ also "disconnect" this relationship with:
+
+ WinSetWindowBits (hwndFrameChild, QWL_STYLE
+ , FS_NOMOVEWITHOWNER
+ , FS_NOMOVEWITHOWNER);
+
+ Adding a button icon later:
+
+ /* switch the button style to BS_MINIICON */
+ WinSetWindowBits(hwndBtn, QWL_STYLE, BS_MINIICON, BS_MINIICON) ;
+
+ /* set up button control data */
+ BTNCDATA bcd;
+ bcd.cb = sizeof(BTNCDATA);
+ bcd.hImage = WinLoadPointer(HWND_DESKTOP, dllHandle, ID_ICON_BUTTON1) ;
+ bcd.fsCheckState = bcd.fsHiliteState = 0 ;
+
+
+ WNDPARAMS wp;
+ wp.fsStatus = WPM_CTLDATA;
+ wp.pCtlData = &bcd;
+
+ /* add the icon on the button */
+ WinSendMsg(hwndBtn, WM_SETWINDOWPARAMS, (MPARAM)&wp, NULL);
-Show/Hide, Enable/Disable (WinShowWindow(), WinIsWindowVisible(),
-WinEnableWindow(), WinIsWindowEnabled()).
+ MO> Can anyone tell what OS/2 expects of an application to be properly
+ MO> minimized to the desktop?
+ case WM MINMAXFRAME :
+ {
+ BOOL fShow = ! (((PSWP) mp1)->fl & SWP MINIMIZE);
+ HENUM henum;
-Maximize/minimize/restore via WindowPos_set(), check via checking
-WS_MAXIMIZED/WS_MINIMIZED flags (how to get them?).
+ HWND hwndChild;
+
+ WinEnableWindowUpdate ( hwnd, FALSE );
+
+ for (henum=WinBeginEnumWindows(hwnd);
+ (hwndChild = WinGetNextWindow (henum)) != 0; )
+ WinShowWindow ( hwndChild, fShow );
+
+ WinEndEnumWindows ( henum );
+ WinEnableWindowUpdate ( hwnd, TRUE );
+ }
+ break;
+
+Why C<hWindowPos DesktopWindow> gives C<< behind => HWND_TOP >>?
=head1 $^E
@@ -851,6 +1247,37 @@ which returns something other than a boolean, it is impossible to
distinguish failure from a "normal" 0-return. In such cases C<$^E ==
0> indicates an absence of error.
+=head1 EXPORTS
+
+In addition to symbols described above, the following constants (available
+also via module C<OS2::Process::Const>) are exportable. Note that these
+symbols live in package C<OS2::Process::Const>, they are not available
+by full name through C<OS2::Process>!
+
+ HWND_* Standard (abstract) window handles
+ WM_* Message ids
+ SC_* WM_SYSCOMMAND flavor
+ SWP_* Size/move etc flag
+ WC_* Standard window classes
+ PROG_* Program category (PM, VIO etc)
+ QW_* Query-Window flag
+ EDI_* Enumerate-Dialog-Item code
+ WS_* Window Style flag
+ QWS_* Query-window-UShort offsets
+ QWP_* Query-window-pointer offsets
+ QWL_* Query-window-ULong offsets
+ FF_* Frame-window state flags
+ FI_* Frame-window information flags
+ LS_* List box styles
+ FS_* Frame style
+ FCF_* Frame creation flags
+ BS_* Button style
+ MS_* Menu style
+ TBM_* Title bar messages?
+ CF_* Clipboard formats
+ CFI_* Clipboard storage type
+ FID_* ids of subwindows of frames
+
=head1 BUGS
whether a given API dies or returns FALSE/empty-list on error may be
diff --git a/os2/OS2/Process/Process.xs b/os2/OS2/Process/Process.xs
index 159ef49a55..1e75951c5d 100644
--- a/os2/OS2/Process/Process.xs
+++ b/os2/OS2/Process/Process.xs
@@ -245,6 +245,8 @@ file_type(char *path)
return apptype;
}
+/* These use different type of wrapper. Good to check wrappers. ;-) */
+/* XXXX This assumes DOS type return type, without SEVERITY?! */
DeclFuncByORD(HSWITCH, myWinQuerySwitchHandle, ORD_WinQuerySwitchHandle,
(HWND hwnd, PID pid), (hwnd, pid))
DeclFuncByORD(ULONG, myWinQuerySwitchEntry, ORD_WinQuerySwitchEntry,
@@ -253,44 +255,85 @@ DeclFuncByORD(ULONG, myWinSetWindowText, ORD_WinSetWindowText,
(HWND hwnd, char* text), (hwnd, text))
DeclFuncByORD(BOOL, myWinQueryWindowProcess, ORD_WinQueryWindowProcess,
(HWND hwnd, PPID ppid, PTID ptid), (hwnd, ppid, ptid))
-
DeclFuncByORD(ULONG, XmyWinSwitchToProgram, ORD_WinSwitchToProgram,
(HSWITCH hsw), (hsw))
#define myWinSwitchToProgram(hsw) (!CheckOSError(XmyWinSwitchToProgram(hsw)))
-DeclFuncByORD(HWND, myWinQueryActiveWindow, ORD_WinQueryActiveWindow,
- (HWND hwnd), (hwnd))
+DeclWinFunc_CACHE(HWND, QueryWindow, (HWND hwnd, LONG cmd), (hwnd, cmd))
+DeclWinFunc_CACHE(BOOL, QueryWindowPos, (HWND hwnd, PSWP pswp),
+ (hwnd, pswp))
+DeclWinFunc_CACHE(LONG, QueryWindowText,
+ (HWND hwnd, LONG cchBufferMax, PCH pchBuffer),
+ (hwnd, cchBufferMax, pchBuffer))
+DeclWinFunc_CACHE(LONG, QueryClassName, (HWND hwnd, LONG cchMax, PCH pch),
+ (hwnd, cchMax, pch))
+DeclWinFunc_CACHE(HWND, QueryFocus, (HWND hwndDesktop), (hwndDesktop))
+DeclWinFunc_CACHE(BOOL, SetFocus, (HWND hwndDesktop, HWND hwndFocus),
+ (hwndDesktop, hwndFocus))
+DeclWinFunc_CACHE(BOOL, ShowWindow, (HWND hwnd, BOOL fShow), (hwnd, fShow))
+DeclWinFunc_CACHE(BOOL, EnableWindow, (HWND hwnd, BOOL fEnable),
+ (hwnd, fEnable))
+DeclWinFunc_CACHE(BOOL, SetWindowPos,
+ (HWND hwnd, HWND hwndInsertBehind, LONG x, LONG y,
+ LONG cx, LONG cy, ULONG fl),
+ (hwnd, hwndInsertBehind, x, y, cx, cy, fl))
+DeclWinFunc_CACHE(HENUM, BeginEnumWindows, (HWND hwnd), (hwnd))
+DeclWinFunc_CACHE(BOOL, EndEnumWindows, (HENUM henum), (henum))
+DeclWinFunc_CACHE(BOOL, EnableWindowUpdate, (HWND hwnd, BOOL fEnable),
+ (hwnd, fEnable))
+DeclWinFunc_CACHE(BOOL, SetWindowBits,
+ (HWND hwnd, LONG index, ULONG flData, ULONG flMask),
+ (hwnd, index, flData, flMask))
+DeclWinFunc_CACHE(BOOL, SetWindowPtr, (HWND hwnd, LONG index, PVOID p),
+ (hwnd, index, p))
+DeclWinFunc_CACHE(BOOL, SetWindowULong, (HWND hwnd, LONG index, ULONG ul),
+ (hwnd, index, ul))
+DeclWinFunc_CACHE(BOOL, SetWindowUShort, (HWND hwnd, LONG index, USHORT us),
+ (hwnd, index, us))
+DeclWinFunc_CACHE(HWND, IsChild, (HWND hwnd, HWND hwndParent),
+ (hwnd, hwndParent))
+DeclWinFunc_CACHE(HWND, WindowFromId, (HWND hwnd, ULONG id), (hwnd, id))
+DeclWinFunc_CACHE(HWND, EnumDlgItem, (HWND hwndDlg, HWND hwnd, ULONG code),
+ (hwndDlg, hwnd, code))
+DeclWinFunc_CACHE(HWND, QueryDesktopWindow, (HAB hab, HDC hdc), (hab, hdc));
+DeclWinFunc_CACHE(BOOL, SetActiveWindow, (HWND hwndDesktop, HWND hwnd),
+ (hwndDesktop, hwnd));
+
+/* These functions may return 0 on success; check $^E/Perl_rc on res==0: */
+DeclWinFunc_CACHE_resetError(PVOID, QueryWindowPtr, (HWND hwnd, LONG index),
+ (hwnd, index))
+DeclWinFunc_CACHE_resetError(ULONG, QueryWindowULong, (HWND hwnd, LONG index),
+ (hwnd, index))
+DeclWinFunc_CACHE_resetError(SHORT, QueryWindowUShort, (HWND hwnd, LONG index),
+ (hwnd, index))
+DeclWinFunc_CACHE_resetError(LONG, QueryWindowTextLength, (HWND hwnd), (hwnd))
+DeclWinFunc_CACHE_resetError(HWND, QueryActiveWindow, (HWND hwnd), (hwnd))
+DeclWinFunc_CACHE_resetError(BOOL, PostMsg,
+ (HWND hwnd, ULONG msg, MPARAM mp1, MPARAM mp2),
+ (hwnd, msg, mp1, mp2))
+DeclWinFunc_CACHE_resetError(HWND, GetNextWindow, (HENUM henum), (henum))
+DeclWinFunc_CACHE_resetError(BOOL, IsWindowEnabled, (HWND hwnd), (hwnd))
+DeclWinFunc_CACHE_resetError(BOOL, IsWindowVisible, (HWND hwnd), (hwnd))
+DeclWinFunc_CACHE_resetError(BOOL, IsWindowShowing, (HWND hwnd), (hwnd))
+
+/* No die()ing on error */
+DeclWinFunc_CACHE_survive(BOOL, IsWindow, (HAB hab, HWND hwnd), (hab, hwnd))
+
+/* These functions are called frow complicated wrappers: */
ULONG (*pWinQuerySwitchList) (HAB hab, PSWBLOCK pswblk, ULONG usDataLength);
ULONG (*pWinChangeSwitchEntry) (HSWITCH hsw, __const__ SWCNTRL *pswctl);
-
-HWND (*pWinQueryWindow) (HWND hwnd, LONG cmd);
-BOOL (*pWinQueryWindowPos) (HWND hwnd, PSWP pswp);
-LONG (*pWinQueryWindowText) (HWND hwnd, LONG cchBufferMax, PCH pchBuffer);
-LONG (*pWinQueryWindowTextLength) (HWND hwnd);
-LONG (*pWinQueryClassName) (HWND hwnd, LONG cchMax, PCH pch);
-HWND (*pWinQueryFocus) (HWND hwndDesktop);
-BOOL (*pWinSetFocus) (HWND hwndDesktop, HWND hwndFocus);
-BOOL (*pWinShowWindow) (HWND hwnd, BOOL fShow);
-BOOL (*pWinPostMsg) (HWND hwnd, ULONG msg, MPARAM mp1, MPARAM mp2);
-BOOL (*pWinSetWindowPos) (HWND hwnd, HWND hwndInsertBehind, LONG x, LONG y,
- LONG cx, LONG cy, ULONG fl);
-HENUM (*pWinBeginEnumWindows) (HWND hwnd);
-BOOL (*pWinEndEnumWindows) (HENUM henum);
-HWND (*pWinGetNextWindow) (HENUM henum);
-BOOL (*pWinIsWindow) (HAB hab, HWND hwnd);
-HWND (*pWinQueryWindow) (HWND hwnd, LONG cmd);
-
-DeclWinFuncByORD(HWND, IsChild, ORD_WinIsChild,
- (HWND hwnd, HWND hwndParent), (hwnd, hwndParent))
-DeclWinFuncByORD(HWND, WindowFromId, ORD_WinWindowFromId,
- (HWND hwnd, ULONG id), (hwnd, id))
-
HWND (*pWinWindowFromPoint)(HWND hwnd, __const__ POINTL *pptl, BOOL fChildren);
-DeclWinFuncByORD(HWND, EnumDlgItem, ORD_WinEnumDlgItem,
- (HWND hwndDlg, HWND hwnd, ULONG code), (hwndDlg, hwnd, code));
+
+/* These functions have different names/signatures than what is
+ declared above */
+#define QueryFocusWindow QueryFocus
+#define FocusWindow_set(hwndFocus, hwndDesktop) SetFocus(hwndDesktop, hwndFocus)
+#define WindowPos_set(hwnd, x, y, fl, cx, cy, hwndInsertBehind) \
+ SetWindowPos(hwnd, hwndInsertBehind, x, y, cx, cy, fl)
+#define myWinQueryWindowPtr(hwnd, i) ((ULONG)QueryWindowPtr(hwnd, i))
int
WindowText_set(HWND hwnd, char* text)
@@ -298,31 +341,25 @@ WindowText_set(HWND hwnd, char* text)
return !CheckWinError(myWinSetWindowText(hwnd, text));
}
-LONG
-QueryWindowTextLength(HWND hwnd)
-{
- LONG ret;
-
- if (!pWinQueryWindowTextLength)
- AssignFuncPByORD(pWinQueryWindowTextLength, ORD_WinQueryWindowTextLength);
- ret = pWinQueryWindowTextLength(hwnd);
- CheckWinError(ret); /* May put false positive */
- return ret;
-}
-
SV *
-QueryWindowText(HWND hwnd)
+myQueryWindowText(HWND hwnd)
{
- LONG l = QueryWindowTextLength(hwnd);
- SV *sv = newSVpvn("", 0);
+ LONG l = QueryWindowTextLength(hwnd), len;
+ SV *sv;
STRLEN n_a;
- if (l == 0)
- return sv;
+ if (l == 0) {
+ if (Perl_rc) /* Last error */
+ return &PL_sv_undef;
+ return &PL_sv_no;
+ }
+ sv = newSVpvn("", 0);
SvGROW(sv, l + 1);
- if (!pWinQueryWindowText)
- AssignFuncPByORD(pWinQueryWindowText, ORD_WinQueryWindowText);
- CheckWinError(l = pWinQueryWindowText(hwnd, l + 1, SvPV_force(sv, n_a)));
+ len = WinQueryWindowText(hwnd, l + 1, SvPV_force(sv, n_a));
+ if (len != l) {
+ Safefree(sv);
+ croak("WinQueryWindowText() uncompatible with WinQueryWindowTextLength()");
+ }
SvCUR_set(sv, l);
return sv;
}
@@ -332,9 +369,7 @@ QueryWindowSWP_(HWND hwnd)
{
SWP swp;
- if (!pWinQueryWindowPos)
- AssignFuncPByORD(pWinQueryWindowPos, ORD_WinQueryWindowPos);
- if (CheckWinError(pWinQueryWindowPos(hwnd, &swp)))
+ if (!QueryWindowPos(hwnd, &swp))
croak("WinQueryWindowPos() error");
return swp;
}
@@ -348,112 +383,24 @@ QueryWindowSWP(HWND hwnd)
}
SV *
-QueryClassName(HWND hwnd)
+myQueryClassName(HWND hwnd)
{
SV *sv = newSVpvn("",0);
STRLEN l = 46, len = 0, n_a;
- if (!pWinQueryClassName)
- AssignFuncPByORD(pWinQueryClassName, ORD_WinQueryClassName);
while (l + 1 >= len) {
if (len)
len = 2*len + 10; /* Grow quick */
else
len = l + 2;
SvGROW(sv, len);
- l = pWinQueryClassName(hwnd, len, SvPV_force(sv, n_a));
- CheckWinError(l);
- SvCUR_set(sv, l);
+ l = QueryClassName(hwnd, len, SvPV_force(sv, n_a));
}
+ SvCUR_set(sv, l);
return sv;
}
HWND
-QueryFocusWindow(HWND hwndDesktop)
-{
- HWND ret;
-
- if (!pWinQueryFocus)
- AssignFuncPByORD(pWinQueryFocus, ORD_WinQueryFocus);
- ret = pWinQueryFocus(hwndDesktop);
- CheckWinError(ret);
- return ret;
-}
-
-BOOL
-FocusWindow_set(HWND hwndFocus, HWND hwndDesktop)
-{
- if (!pWinSetFocus)
- AssignFuncPByORD(pWinSetFocus, ORD_WinSetFocus);
- return !CheckWinError(pWinSetFocus(hwndDesktop, hwndFocus));
-}
-
-BOOL
-ShowWindow(HWND hwnd, BOOL fShow)
-{
- if (!pWinShowWindow)
- AssignFuncPByORD(pWinShowWindow, ORD_WinShowWindow);
- return !CheckWinError(pWinShowWindow(hwnd, fShow));
-}
-
-BOOL
-PostMsg(HWND hwnd, ULONG msg, ULONG mp1, ULONG mp2)
-{
- if (!pWinPostMsg)
- AssignFuncPByORD(pWinPostMsg, ORD_WinPostMsg);
- return !CheckWinError(pWinPostMsg(hwnd, msg, (MPARAM)mp1, (MPARAM)mp2));
-}
-
-BOOL
-WindowPos_set(HWND hwnd, LONG x, LONG y, ULONG fl, LONG cx, LONG cy,
- HWND hwndInsertBehind)
-{
- if (!pWinSetWindowPos)
- AssignFuncPByORD(pWinSetWindowPos, ORD_WinSetWindowPos);
- return !CheckWinError(pWinSetWindowPos(hwnd, hwndInsertBehind, x, y, cx, cy, fl));
-}
-
-HENUM
-BeginEnumWindows(HWND hwnd)
-{
- if (!pWinBeginEnumWindows)
- AssignFuncPByORD(pWinBeginEnumWindows, ORD_WinBeginEnumWindows);
- return SaveWinError(pWinBeginEnumWindows(hwnd));
-}
-
-BOOL
-EndEnumWindows(HENUM henum)
-{
- if (!pWinEndEnumWindows)
- AssignFuncPByORD(pWinEndEnumWindows, ORD_WinEndEnumWindows);
- return !CheckWinError(pWinEndEnumWindows(henum));
-}
-
-HWND
-GetNextWindow(HENUM henum)
-{
- if (!pWinGetNextWindow)
- AssignFuncPByORD(pWinGetNextWindow, ORD_WinGetNextWindow);
- return SaveWinError(pWinGetNextWindow(henum));
-}
-
-BOOL
-IsWindow(HWND hwnd, HAB hab)
-{
- if (!pWinIsWindow)
- AssignFuncPByORD(pWinIsWindow, ORD_WinIsWindow);
- return !CheckWinError(pWinIsWindow(hab, hwnd));
-}
-
-HWND
-QueryWindow(HWND hwnd, LONG cmd)
-{
- if (!pWinQueryWindow)
- AssignFuncPByORD(pWinQueryWindow, ORD_WinQueryWindow);
- return !CheckWinError(pWinQueryWindow(hwnd, cmd));
-}
-
-HWND
WindowFromPoint(long x, long y, HWND hwnd, BOOL fChildren)
{
POINTL ppl;
@@ -474,7 +421,7 @@ fill_swentry(SWENTRY *swentryp, HWND hwnd, PID pid)
croak("switch_entry not implemented on DOS"); /* not OS/2. */
if (CheckWinError(hSwitch =
myWinQuerySwitchHandle(hwnd, pid)))
- croak("WinQuerySwitchHandle err %ld", Perl_rc);
+ croak("WinQuerySwitchHandle: %s", os2error(Perl_rc));
swentryp->hswitch = hSwitch;
if (CheckOSError(myWinQuerySwitchEntry(hSwitch, &swentryp->swctl)))
croak("WinQuerySwitchEntry err %ld", rc);
@@ -899,8 +846,16 @@ sidOf(int pid)
return sid;
}
+#define ulMPFROMSHORT(i) ((unsigned long)MPFROMSHORT(i))
+#define ulMPVOID() ((unsigned long)MPVOID)
+#define ulMPFROMCHAR(i) ((unsigned long)MPFROMCHAR(i))
+#define ulMPFROM2SHORT(x1,x2) ((unsigned long)MPFROM2SHORT(x1,x2))
+#define ulMPFROMSH2CH(s, c1, c2) ((unsigned long)MPFROMSH2CH(s, c1, c2))
+#define ulMPFROMLONG(x) ((unsigned long)MPFROMLONG(x))
+
MODULE = OS2::Process PACKAGE = OS2::Process
+PROTOTYPES: ENABLE
unsigned long
constant(name,arg)
@@ -939,6 +894,7 @@ swentry_expand( SV *sv )
SV *
create_swentry( char *title, unsigned long sw_hwnd, unsigned long icon_hwnd, unsigned long owner_phandle, unsigned long owner_pid, unsigned long owner_sid, unsigned long visible, unsigned long switchable, unsigned long jumpable, unsigned long ptype, unsigned long sw_entry)
+PROTOTYPE: DISABLE
int
change_swentry( SV *sv )
@@ -949,6 +905,7 @@ sesmgr_title_set(s)
SV *
process_swentry(unsigned long pid = getpid(), unsigned long hwnd = NULLHANDLE);
+ PROTOTYPE: DISABLE
int
swentry_size()
@@ -956,6 +913,9 @@ swentry_size()
SV *
swentries_list()
+void
+ResetWinError()
+
int
WindowText_set(unsigned long hwndFrame, char *title)
@@ -966,10 +926,15 @@ bool
ShowWindow(unsigned long hwnd, bool fShow = TRUE)
bool
+EnableWindow(unsigned long hwnd, bool fEnable = TRUE)
+
+bool
PostMsg(unsigned long hwnd, unsigned long msg, unsigned long mp1 = 0, unsigned long mp2 = 0)
+ C_ARGS: hwnd, msg, (MPARAM)mp1, (MPARAM)mp2
bool
WindowPos_set(unsigned long hwnd, long x, long y, unsigned long fl = SWP_MOVE, long cx = 0, long cy = 0, unsigned long hwndInsertBehind = HWND_TOP)
+ PROTOTYPE: DISABLE
unsigned long
BeginEnumWindows(unsigned long hwnd)
@@ -981,7 +946,13 @@ unsigned long
GetNextWindow(unsigned long henum)
bool
-IsWindow(unsigned long hwnd, unsigned long hab = Acquire_hab())
+IsWindowVisible(unsigned long hwnd)
+
+bool
+IsWindowEnabled(unsigned long hwnd)
+
+bool
+IsWindowShowing(unsigned long hwnd)
unsigned long
QueryWindow(unsigned long hwnd, long cmd)
@@ -993,12 +964,38 @@ unsigned long
WindowFromId(unsigned long hwndParent, unsigned long id)
unsigned long
-WindowFromPoint(long x, long y, unsigned long hwnd, bool fChildren = 0)
+WindowFromPoint(long x, long y, unsigned long hwnd = HWND_DESKTOP, bool fChildren = TRUE)
+PROTOTYPE: DISABLE
unsigned long
EnumDlgItem(unsigned long hwndDlg, unsigned long code, unsigned long hwnd = NULLHANDLE)
C_ARGS: hwndDlg, hwnd, code
+bool
+EnableWindowUpdate(unsigned long hwnd, bool fEnable = TRUE)
+
+bool
+SetWindowBits(unsigned long hwnd, long index, unsigned long flData, unsigned long flMask)
+
+bool
+SetWindowPtr(unsigned long hwnd, long index, unsigned long p)
+ C_ARGS: hwnd, index, (PVOID)p
+
+bool
+SetWindowULong(unsigned long hwnd, long index, unsigned long i)
+
+bool
+SetWindowUShort(unsigned long hwnd, long index, unsigned short i)
+
+bool
+IsWindow(unsigned long hwnd, unsigned long hab = Acquire_hab())
+ C_ARGS: hab, hwnd
+
+BOOL
+ActiveWindow_set(unsigned long hwnd, unsigned long hwndDesktop = HWND_DESKTOP)
+ CODE:
+ RETVAL = SetActiveWindow(hwndDesktop, hwnd);
+
int
out_codepage()
@@ -1035,6 +1032,21 @@ process_codepages()
bool
process_codepage_set(int cp)
+void
+cursor(OUTLIST int stp, OUTLIST int ep, OUTLIST int wp, OUTLIST int ap)
+ PROTOTYPE:
+
+bool
+cursor_set(int s, int e, int w = cursor__(0), int a = cursor__(1))
+
+MODULE = OS2::Process PACKAGE = OS2::Process PREFIX = myQuery
+
+SV *
+myQueryWindowText(unsigned long hwnd)
+
+SV *
+myQueryClassName(unsigned long hwnd)
+
MODULE = OS2::Process PACKAGE = OS2::Process PREFIX = Query
unsigned long
@@ -1044,35 +1056,40 @@ long
QueryWindowTextLength(unsigned long hwnd)
SV *
-QueryWindowText(unsigned long hwnd)
-
-SV *
QueryWindowSWP(unsigned long hwnd)
-SV *
-QueryClassName(unsigned long hwnd)
+unsigned long
+QueryWindowULong(unsigned long hwnd, long index)
-MODULE = OS2::Process PACKAGE = OS2::Process PREFIX = myWin
+unsigned short
+QueryWindowUShort(unsigned long hwnd, long index)
+
+unsigned long
+QueryActiveWindow(unsigned long hwnd = HWND_DESKTOP)
+
+unsigned long
+QueryDesktopWindow(unsigned long hab = Acquire_hab(), unsigned long hdc = NULLHANDLE)
+
+MODULE = OS2::Process PACKAGE = OS2::Process PREFIX = myWinQuery
+
+unsigned long
+myWinQueryWindowPtr(unsigned long hwnd, long index)
NO_OUTPUT BOOL
myWinQueryWindowProcess(unsigned long hwnd, OUTLIST unsigned long pid, OUTLIST unsigned long tid)
+ PROTOTYPE: $
POSTCALL:
if (CheckWinError(RETVAL))
- croak("QueryWindowProcess() error");
-
-void
-cursor(OUTLIST int stp, OUTLIST int ep, OUTLIST int wp, OUTLIST int ap)
+ croak("WindowProcess() error");
-bool
-cursor_set(int s, int e, int w = cursor__(0), int a = cursor__(1))
+MODULE = OS2::Process PACKAGE = OS2::Process PREFIX = myWin
int
myWinSwitchToProgram(unsigned long hsw)
PREINIT:
ULONG rc;
-unsigned long
-myWinQueryActiveWindow(unsigned long hwnd = HWND_DESKTOP)
+MODULE = OS2::Process PACKAGE = OS2::Process PREFIX = myWinQuery
MODULE = OS2::Process PACKAGE = OS2::Process PREFIX = get
@@ -1087,6 +1104,30 @@ sidOf(int pid = getpid())
void
getscrsize(OUTLIST int wp, OUTLIST int hp)
+ PROTOTYPE:
bool
scrsize_set(int w_or_h, int h = -9999)
+
+MODULE = OS2::Process PACKAGE = OS2::Process PREFIX = ul
+
+unsigned long
+ulMPFROMSHORT(unsigned short i)
+
+unsigned long
+ulMPVOID()
+
+unsigned long
+ulMPFROMCHAR(unsigned char i)
+
+unsigned long
+ulMPFROM2SHORT(unsigned short x1, unsigned short x2)
+ PROTOTYPE: DISABLE
+
+unsigned long
+ulMPFROMSH2CH(unsigned short s, unsigned char c1, unsigned char c2)
+ PROTOTYPE: DISABLE
+
+unsigned long
+ulMPFROMLONG(unsigned long x)
+
diff --git a/os2/OS2/Process/t/os2_process.t b/os2/OS2/Process/t/os2_process.t
new file mode 100644
index 0000000000..f17104752a
--- /dev/null
+++ b/os2/OS2/Process/t/os2_process.t
@@ -0,0 +1,504 @@
+#! /usr/bin/perl -w
+
+#END {
+# sleep 10;
+#}
+
+sub propagate_INC {
+ my $inc = $ENV{PERL5LIB};
+ $inc = $ENV{PERLLIB} unless defined $inc;
+ $inc = '' unless defined $inc;
+ $ENV{PERL5LIB} = join ';', @INC, split /;/, $inc;
+}
+
+my $separate_session;
+BEGIN { # Remap I/O to the parent's window
+ $separate_session = $ENV{OS2_PROCESS_TEST_SEPARATE_SESSION};
+ propagate_INC, return unless $separate_session; # done by the parent
+ my @fn = split " ", $ENV{NEW_FD};
+ my @fh = (*STDOUT, *STDERR);
+ my @how = qw( > > );
+ # warn $_ for @fn;
+ open $fh[$_], "$how[$_]&=$fn[$_]"
+ or warn "Cannot reopen $fh[$_], $how[$_]&=$fn[$_]: $!" for 0..1;
+}
+
+use strict;
+use Test::More tests => 227;
+use OS2::Process;
+
+sub SWP_flags ($) {
+ my @nkpos = WindowPos shift;
+ $nkpos[2];
+}
+
+my $interactive_wait = @ARGV && $ARGV[0] eq 'wait';
+
+my @l = OS2::Process::process_entry();
+ok(@l == 11, 'all the fields of the process_entry() are there');
+
+# 1: FS 2: Window-VIO
+ok( ($l[9] == 1 or $l[9] == 2), 'we are FS or Windowed-VIO');
+
+#print "# $_\n" for @l;
+
+eval <<'EOE' or die;
+#use OS2::Process qw(WM_SYSCOMMAND WM_DBCSLAST FID_CLIENT HWND_DESKTOP);
+use OS2::Process qw(WM_SYSCOMMAND WM_DBCSLAST HWND_DESKTOP);
+
+ok( WM_SYSCOMMAND == 0x0021, 'correct WM_SYSCOMMAND' );
+ok( WM_DBCSLAST == 0x00cf, 'correct WM_DBCSLAST' );
+#ok( FID_CLIENT == 0x8008 );
+ok( HWND_DESKTOP == 0x0001, 'correct HWND_DESKTOP' );
+1;
+EOE
+
+my $t = Title;
+my $wint = winTitle;
+
+ok($t, 'got session title');
+ok($wint, 'got titlebar text');
+
+my $newt = "test OS2::Process $$";
+ok(Title_set($newt), 'successfully set Title');
+is(Title, $newt, 'correctly set Title');
+my $wt = winTitle or warn "winTitle: $!, $^E";
+is(winTitle, $newt, 'winTitle changed its value too');
+ok(Title_set $t, 'successfully set Title back');
+is(Title, $t, 'correctly set Title back');
+is(winTitle, $wint, 'winTitle restored its value too');
+
+$newt = "test OS2::Process both-$$";
+ok(bothTitle_set($newt), 'successfully set both titles via Win* API');
+is(Title, $newt, 'session title correctly set');
+is(winTitle, $newt, 'winTitle correctly set');
+ok(bothTitle_set($t), 'successfully reset both titles via Win* API');
+is(Title, $t, 'session title correctly reset');
+is(winTitle, $wint, 'winTitle correctly reset');
+
+$newt = "test OS2::Process win-$$";
+ok(winTitle_set($newt), 'successfully set titlebar title via Win* API');
+is(Title, $t, 'session title remained the same');
+is(winTitle, $newt, 'winTitle changed value');
+ok(winTitle_set($wint), 'successfully reset titlebar title via Win* API');
+is(Title, $t, 'session title remained the same');
+is(winTitle, $wint, 'winTitle restored value');
+
+$newt = "test OS2::Process sw-$$";
+ok(swTitle_set($newt), 'successfully set session title via Win* API');
+is(Title, $newt, 'session title correctly set');
+is(winTitle, $wint, 'winTitle has unchanged value');
+ok(swTitle_set($t), 'successfully reset session title via Win* API');
+is(Title, $t, 'session title correctly set');
+is(winTitle, $wint, 'winTitle has unchanged value');
+
+$newt = "test OS2::Process again-$$";
+ok(Title_set($newt), 'successfully set Title again');
+is(Title, $newt, 'correctly set Title again');
+is(winTitle, $newt, 'winTitle changed its value too again');
+ok(Title_set($t), 'successfully set Title back');
+is(Title, $t, 'correctly set Title back');
+is(winTitle, $wint, 'winTitle restored its value too again');
+
+my $hwnd = process_hwnd;
+ok($hwnd, 'found session owner hwnd');
+my $c_subhwnd = WindowFromId $hwnd, 0x8008; # FID_CLIENT;
+ok($c_subhwnd, 'found client hwnd');
+my $a_subhwnd = ActiveWindow $hwnd; # or $^E and warn $^E;
+ok((not $a_subhwnd and not $^E), 'No active subwindow in a VIO frame');
+
+my $ahwnd = ActiveWindow;
+ok($ahwnd, 'found active window');
+my $fhwnd = FocusWindow;
+ok($fhwnd, 'found focus window');
+
+# This call without morphing results in VIO window with active highlight, but
+# no keyboard focus (even after Alt-Tabbing to it; you cannot Alt-Tab off it!)
+
+# Interestingly, Desktop is active on the switch list, but the
+# switch list is not acting on keyboard events.
+
+# Give up focus
+{ my $force_PM = OS2::localMorphPM->new(0);
+ ok $force_PM, 'morphed to PM locally';
+ ok FocusWindow_set(1), 'set focus to DESKTOP'; # HWND_DESKTOP
+}
+my $dtop = DesktopWindow;
+ok($dtop, 'found the desktop window');
+
+#OS2::Process::ResetWinError; # XXXX Should not be needed!
+$ahwnd = ActiveWindow or $^E and warn $^E;
+ok( (not $ahwnd and not $^E), 'desktop is not active');
+$fhwnd = FocusWindow;
+ok($fhwnd, 'there is a focus window');
+is($fhwnd, $dtop, 'which is the desktop');
+
+# XXXX Well, no need to skip it now...
+SKIP: {
+ skip 'We already have focus', 4 if $hwnd == $ahwnd;
+ my $force_PM = OS2::localMorphPM->new(0);
+ ok $force_PM, 'morphed to PM locally again';
+ ok FocusWindow_set($c_subhwnd), 'set focus to the client of the session owner';
+ # If we do not morph, then when the focus is in another VIO frame,
+ # we get two VIO frames with activated titlebars.
+ # The only (?) way to take the activated state from another frame
+ # is to switch to it via the switch list
+ $ahwnd = ActiveWindow;
+ ok($ahwnd, 'there is an active window');
+ $fhwnd = FocusWindow;
+ ok($fhwnd, 'there is a focus window');
+ is($hwnd, $ahwnd, 'the active window is the session owner');
+ is($fhwnd, $c_subhwnd, 'the focus window is the client of the session owner');
+}
+
+# Give up focus again
+{ my $force_PM = OS2::localMorphPM->new(0);
+ ok $force_PM, 'morphed to PM locally again';
+ ok FocusWindow_set(1), 'set focus to DESKTOP again'; # HWND_DESKTOP
+}
+
+$ahwnd = ActiveWindow or $^E and warn $^E;
+ok( (not $ahwnd and not $^E), 'desktop is not active again');
+$fhwnd = FocusWindow;
+ok($fhwnd, 'there is a focus window');
+is($fhwnd, $dtop, 'which is the desktop');
+
+# XXXX Well, no need to skip it now...
+SKIP: {
+ skip 'We already have focus', 4 if $hwnd == $ahwnd;
+ my $force_PM = OS2::localMorphPM->new(0);
+ ok $force_PM, 'morphed to PM locally again';
+ ok ActiveWindow_set($hwnd), 'activate the session owner';
+ $ahwnd = ActiveWindow;
+ ok($ahwnd, 'there is an active window');
+ $fhwnd = FocusWindow;
+ ok($fhwnd, 'there is a focus window');
+ is($hwnd, $ahwnd, 'the active window is the session owner');
+}
+
+# XXXX Well, no need to skip it now...
+SKIP: {
+ skip 'Tests assume we have focus', 1 unless $hwnd == $ahwnd;
+ # We have focus
+ # is($fhwnd, $ahwnd);
+ # is($a_subhwnd, $c_subhwnd);
+ is($fhwnd, $c_subhwnd, 'the focus window is the client of the session owner');
+}
+
+# Check enumeration of switch entries:
+my $skid_title = "temporary s-kid ppid=$$";
+my $spid = system P_SESSION, $^X, '-wle', "END {sleep 25} use OS2::Process; eval {Title_set '$skid_title'} or warn \$@; \$SIG{TERM} = sub {exit 0}";
+ok ($spid, 'start the new VIO session with unique title');
+sleep 1;
+my @sw = grep $_->{title} eq $skid_title, process_hentries;
+sleep 1000 unless @sw;
+is(scalar @sw, 1, 'exactly one session with this title');
+my $sw = $sw[0];
+ok $sw, 'have the data about the session';
+is($sw->{owner_pid}, $spid, 'session has a correct pid');
+my $k_hwnd = $sw->{owner_hwnd};
+ok $k_hwnd, 'found the session window handle';
+is sidOf($spid), $sw->{owner_sid}, 'we know sid of the session';
+
+# Give up focus again
+{ my $force_PM = OS2::localMorphPM->new(0);
+ ok $force_PM, 'morphed to PM locally again';
+ ok FocusWindow_set($k_hwnd), 'set focus to kid session window';
+}
+
+$ahwnd = ActiveWindow;
+ok $ahwnd, 'there is an active window';
+is $ahwnd, $k_hwnd, 'after focusing the active window is the owner_hwnd';
+$fhwnd = FocusWindow;
+ok $fhwnd, 'there is a focus window';
+my $c_sub_ahwnd = WindowFromId $ahwnd, 0x8008; # FID_CLIENT;
+ok $c_sub_ahwnd, 'the active window has a FID_CLIENT';
+is($fhwnd, $ahwnd, 'the focus window = the active window');
+
+ok hWindowPos_set({behind => 3}, $k_hwnd), # HWND_TOP
+ 'put kid to the front';
+
+is((hWindowPos $k_hwnd)->{behind}, 3, 'kis is at front');
+
+my ($enum_handle, $first_zorder);
+{ my $force_PM = OS2::localMorphPM->new(0);
+ ok $force_PM, 'morphed to PM locally again';
+ $enum_handle = BeginEnumWindows 1; # HWND_DESKTOP
+ ok $enum_handle, 'start enumeration';
+ $first_zorder = GetNextWindow $enum_handle;
+ ok $first_zorder, 'GetNextWindow works';
+ ok EndEnumWindows($enum_handle), 'end enumeration';
+}
+is ($first_zorder, $k_hwnd, 'kid is the first in z-order enumeration');
+
+ok hWindowPos_set({behind => 4}, $k_hwnd), # HWND_BOTTOM
+ 'put kid to the back';
+
+# This does not work, the result is the handle of "Window List"
+# is((hWindowPos $k_hwnd)->{behind}, 4, 'kis is at back');
+
+my (@list, $next);
+{ my $force_PM = OS2::localMorphPM->new(0);
+ ok $force_PM, 'morphed to PM locally again';
+ $enum_handle = BeginEnumWindows 1; # HWND_DESKTOP
+ ok $enum_handle, 'start enumeration';
+ push @list, $next while $next = GetNextWindow $enum_handle;
+ ok EndEnumWindows($enum_handle), 'end enumeration';
+
+ # Apparently, the 'Desktop' window is still behind us;
+ # Note that this window is *not* what is returned by DesktopWindow
+ pop @list if WindowText($list[-1]) eq 'Desktop';
+}
+is ($list[-1], $k_hwnd, 'kid is the last in z-order enumeration');
+# print "# kid=$k_hwnd in @list\n";
+@list = ChildWindows; # HWND_DESKTOP
+ok scalar @list, 'ChildWindows works';
+is $list[-2], $k_hwnd, 'kid is the last but one in ChildWindows';
+
+ok hWindowPos_set({behind => 3}, $k_hwnd), # HWND_TOP
+ 'put kid to the front again';
+
+is((hWindowPos $k_hwnd)->{behind}, 3, 'kis is at front again');
+sleep 5 if $interactive_wait;
+
+ok IsWindow($k_hwnd), 'IsWindow works';
+#print "# win=$k_hwnd => err=$^E\n";
+my $c_sub_khwnd = WindowFromId $k_hwnd, 0x8008; # FID_CLIENT
+ok $c_sub_khwnd, 'have kids client window';
+ok IsWindow($c_sub_khwnd), 'IsWindow works on the client';
+#print "# win=$c_sub_khwnd => IsWindow err=$^E\n";
+my ($pkid,$tkid) = WindowProcess $c_sub_khwnd;
+my ($pkid1,$tkid1) = WindowProcess $hwnd;
+ok($pkid1 > 0, 'our window has a governing process');
+ok($tkid1 > 0, 'our window has a governing thread');
+is($pkid, $pkid1, 'kid\'s window is governed by the same process as our (PMSHELL:1)');
+is($tkid, $tkid1, 'likewise for threads');
+is $pkid, ppidOf($spid), 'the governer is the parent of the kid session';
+
+my $my_pos = hWindowPos($hwnd);
+ok $my_pos, 'got my position';
+{ my $force_PM = OS2::localMorphPM->new(0);
+ ok $force_PM, 'morphed to PM locally again';
+ my @pos = WindowPos $hwnd;
+ my @ppos = WindowPos $k_hwnd;
+ # ok hWindowPos_set({%$my_pos, behind => $hwnd}, $k_hwnd), 'hide the kid behind us';
+ # Hide it completely behind our window
+ ok hWindowPos_set({x => $my_pos->{x}, y => $my_pos->{y}, behind => $hwnd,
+ width => $my_pos->{width}, height => $my_pos->{height}},
+ $k_hwnd), 'hide the kid behind us';
+ # ok WindowPos_set($k_hwnd, $pos[0], $pos[1]), 'hide the kid behind us';
+ my @kpos = WindowPos $k_hwnd;
+ # print "# kidpos=@ppos\n";
+ # print "# mypos=@pos\n";
+ # print "# kidpos=@kpos\n";
+# kidpos=252 630 4111 808 478 3 66518088 502482793
+# mypos=276 78 4111 491 149 2147484137 66518060 502532977
+# kidpos=276 78 4111 491 149 2147484255 1392374582 213000
+ print "# Before window position\n" if $interactive_wait;
+ sleep 5 if $interactive_wait;
+
+ my $w_at = WindowFromPoint($kpos[0] + 5, $kpos[0] + 5, 1, 0); # HWND_DESKTOP, no grandchildren
+ ok $w_at, 'got window near LL corner of the kid';
+ print "# we=$hwnd, our client=$c_subhwnd, kid=$k_hwnd, kid's client=$c_sub_khwnd\n";
+ #is $w_at, $c_sub_khwnd, 'it is the kids client';
+ #is $w_at, $k_hwnd, 'it is the kids frame';
+ # Apparently, this result is accidental only...
+# is $w_at, $hwnd, 'it is our frame - is on top, but no focus';
+ #is $w_at, $c_subhwnd, 'it is our client';
+ print "# text: `", WindowText $w_at, "'.\n";
+ $w_at = WindowFromPoint($kpos[0] + 5, $kpos[0] + 5); # HWND_DESKTOP, grandchildren too
+ ok $w_at, 'got grandkid window near LL corner of the kid';
+ # Apparently, this result is accidental only...
+# is $w_at, $c_subhwnd, 'it is our client';
+ print "# text: `", WindowText $w_at, "'.\n";
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ ok IsWindowShowing $hwnd, 'we are showing';
+ ok ((not IsWindowShowing $k_hwnd), 'kid is not showing');
+ ok ((not eval { IsWindowShowing 12; 1 }), 'wrong kid causes errors');
+ is $^E+0, 0x1001, 'error is 0x1001';
+ like $@, qr/\Q[Win]IsWindowShowing/, 'error message shows function';
+ like $@, qr/SYS4097\b/, 'error message shows error number';
+ like $@, qr/\b0x1001\b/, 'error message shows error number in hex';
+
+ ok WindowPos_set($k_hwnd, @ppos[0..5]), 'restore the kid position';
+ my @nkpos = WindowPos $k_hwnd;
+ my $fl = $nkpos[2];
+ is_deeply([@ppos[0..5]], [@nkpos[0..5]], 'position restored');
+ ok IsWindowShowing $k_hwnd, 'kid is showing';
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ sleep 5 if $interactive_wait;
+ ok EnableWindow($k_hwnd, 0), 'disable the kid';
+ ok IsWindowShowing $k_hwnd, 'kid is showing';
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok !IsWindowEnabled $k_hwnd, 'kid is flaged as not enabled';
+ ok EnableWindow($k_hwnd), 'enable the kid';
+ ok IsWindowShowing $k_hwnd, 'kid is showing';
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ ok ShowWindow($k_hwnd, 0), 'hide the kid';
+ ok !IsWindowShowing $k_hwnd, 'kid is not showing';
+ ok !IsWindowVisible $k_hwnd, 'kid is flaged as not visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ ok ShowWindow($k_hwnd), 'show the kid';
+ ok IsWindowShowing $k_hwnd, 'kid is showing';
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ ok( ($fl & 0x1800), 'window is maximized or restored'); # SWP_MAXIMIZE SWP_RESTORE
+ ok( ($fl & 0x1800) != 0x1800, 'window is not maximized AND restored'); # SWP_MAXIMIZE SWP_RESTORE
+
+ ok PostMsg( $k_hwnd, 0x21, # WM_SYSCOMMAND, SC_MINIMIZE
+ OS2::Process::MPFROMSHORT 0x8002), 'post minimize message';
+ sleep 1;
+ ok !IsWindowShowing $k_hwnd, 'kid is not showing';
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ is 0x1c00 & SWP_flags $k_hwnd, 0x400, 'kid is minimized'; # SWP_MINIMIZE
+
+ ok PostMsg($k_hwnd, 0x21, # WM_SYSCOMMAND, SC_RESTORE
+ OS2::Process::MPFROMSHORT 0x8008), 'post restore message';
+ sleep 1;
+ ok IsWindowShowing $k_hwnd, 'kid is showing';
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ is 0x1c00 & SWP_flags $k_hwnd, 0x1000, 'kid is restored'; # SWP_RESTORE
+
+ ok PostMsg($k_hwnd, 0x21, # WM_SYSCOMMAND, SC_MAXIMIZE
+ OS2::Process::MPFROMSHORT 0x8003), 'post maximize message';
+ sleep 1;
+ ok IsWindowShowing $k_hwnd, 'kid is showing';
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ is 0x1c00 & SWP_flags $k_hwnd, 0x800, 'kid is maximized'; # SWP_MAXIMIZE
+
+ ok PostMsg( $k_hwnd, 0x21, # WM_SYSCOMMAND, SC_MINIMIZE
+ OS2::Process::MPFROMSHORT 0x8002), 'post minimize message again';
+ sleep 1;
+ ok !IsWindowShowing $k_hwnd, 'kid is not showing';
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ is 0x1c00 & SWP_flags $k_hwnd, 0x400, 'kid is minimized'; # SWP_MINIMIZE
+
+ ok PostMsg($k_hwnd, 0x21, # WM_SYSCOMMAND, SC_RESTORE
+ OS2::Process::MPFROMSHORT 0x8008), 'post restore message again';
+ sleep 1;
+ ok IsWindowShowing $k_hwnd, 'kid is showing';
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ is 0x1c00 & SWP_flags $k_hwnd, 0x1000, 'kid is restored'; # SWP_RESTORE
+
+ ok PostMsg( $k_hwnd, 0x21, # WM_SYSCOMMAND, SC_MINIMIZE
+ OS2::Process::MPFROMSHORT 0x8002), 'post minimize message again';
+ sleep 1;
+ ok !IsWindowShowing $k_hwnd, 'kid is not showing';
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ is 0x1c00 & SWP_flags $k_hwnd, 0x400, 'kid is minimized'; # SWP_MINIMIZE
+
+ ok PostMsg($k_hwnd, 0x21, # WM_SYSCOMMAND, SC_RESTORE
+ OS2::Process::MPFROMSHORT (($fl & 0x800) ? 0x8003 : 0x8008)), # SWP_MAXIMIZE
+ 'return back to the initial MAXIMIZE/RESTORE state';
+ sleep 1;
+ ok IsWindowShowing $k_hwnd, 'kid is showing';
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ @nkpos = WindowPos $k_hwnd;
+ is_deeply([@ppos[0..5]], [@nkpos[0..5]], 'position restored');
+
+ # Now the other way
+ ok hWindowPos_set( {flags => 0x400}, $k_hwnd), 'set to minimized';
+ ok !IsWindowShowing $k_hwnd, 'kid is not showing';
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ is 0x1c00 & SWP_flags $k_hwnd, 0x400, 'kid is minimized'; # SWP_MINIMIZE
+
+ ok hWindowPos_set( {flags => 0x1000}, $k_hwnd), 'set to restore';
+ ok IsWindowShowing $k_hwnd, 'kid is showing';
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ is 0x1c00 & SWP_flags $k_hwnd, 0x1000, 'kid is restored'; # SWP_RESTORE
+
+ ok hWindowPos_set( {flags => 0x800}, $k_hwnd), 'set to maximized';
+ ok IsWindowShowing $k_hwnd, 'kid is showing';
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ is 0x1c00 & SWP_flags $k_hwnd, 0x800, 'kid is maximized'; # SWP_MAXIMIZE
+
+ ok hWindowPos_set( {flags => 0x400}, $k_hwnd), 'set to minimized again';
+ ok !IsWindowShowing $k_hwnd, 'kid is not showing';
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ is 0x1c00 & SWP_flags $k_hwnd, 0x400, 'kid is minimized'; # SWP_MINIMIZE
+
+ ok hWindowPos_set( {flags => 0x1000}, $k_hwnd), 'set to restore again';
+ ok IsWindowShowing $k_hwnd, 'kid is showing';
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ is 0x1c00 & SWP_flags $k_hwnd, 0x1000, 'kid is restored'; # SWP_RESTORE
+
+ ok hWindowPos_set( {flags => 0x400}, $k_hwnd), 'set to minimized again';
+ ok !IsWindowShowing $k_hwnd, 'kid is not showing';
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ is 0x1c00 & SWP_flags $k_hwnd, 0x400, 'kid is minimized'; # SWP_MINIMIZE
+
+ ok hWindowPos_set( {flags => ($fl & 0x1800)}, $k_hwnd),
+ 'set back to the initial MAXIMIZE/RESTORE state';
+ ok IsWindowShowing $k_hwnd, 'kid is showing';
+ ok IsWindowVisible $k_hwnd, 'kid is flaged as visible';
+ ok IsWindowEnabled $k_hwnd, 'kid is flaged as enabled';
+ @nkpos = WindowPos $k_hwnd;
+ is_deeply([@ppos[0..5]], [@nkpos[0..5]], 'position restored');
+
+}
+
+# XXXX Well, no need to skip it now...
+SKIP: {
+ skip 'We already have focus', 4 if $hwnd == $ahwnd;
+ my $force_PM = OS2::localMorphPM->new(0);
+ ok($force_PM, 'morphed to catch focus again');
+ ok FocusWindow_set($c_subhwnd), 'set focus to the client of the session owner';
+ # If we do not morph, then when the focus is in another VIO frame,
+ # we get two VIO frames with activated titlebars.
+ # The only (?) way to take the activated state from another frame
+ # is to switch to it via the switch list
+ $ahwnd = ActiveWindow;
+ ok($ahwnd, 'there is an active window');
+ $fhwnd = FocusWindow;
+ ok($fhwnd, 'there is a focus window');
+ is($hwnd, $ahwnd, 'the active window is the session owner');
+ is($fhwnd, $c_subhwnd, 'the focus window is the client of the session owner');
+}
+
+SKIP: {
+ skip 'Potentially destructive session modifications, done in a separate session only',
+ 12, unless $separate_session;
+ # Manipulate process' hentry
+ my $he = process_hentry;
+ ok($he, 'got process hentry');
+ ok($he->{visible}, 'session switch is visible');# 4? Assume nobody manipulated it...
+
+ ok change_entryh($he), 'can change it (without modifications)';
+ my $nhe = process_hentry;
+ ok $nhe, 'could refetch the process hentry';
+ is_deeply($nhe, $he, 'it did not change');
+
+ sleep 5 if $interactive_wait;
+ # Try removing the process entry from the switch list
+ $nhe->{visible} = 0;
+ ok change_entryh($nhe), 'can change it to be invisible';
+ my $nnhe = process_hentry;
+ ok($nnhe, 'could refetch the process hentry');
+ is_deeply($nnhe, $nhe, 'it is modified as expected');
+ is($nnhe->{visible}, 0, 'it is not visible');
+
+ sleep 5 if $interactive_wait;
+
+ $nhe->{visible} = 1;
+ ok change_entryh ($nhe), 'can change it to be visible';
+ $nnhe = process_hentry;
+ ok($nnhe, 'could refetch the process hentry');
+ ok($nnhe->{visible}, 'it is visible');
+ sleep 5 if $interactive_wait;
+}
diff --git a/os2/OS2/Process/t/os2_process_kid.t b/os2/OS2/Process/t/os2_process_kid.t
new file mode 100644
index 0000000000..7551d41bda
--- /dev/null
+++ b/os2/OS2/Process/t/os2_process_kid.t
@@ -0,0 +1,64 @@
+#! /usr/bin/perl -w
+
+use strict;
+use OS2::Process; # qw(P_SESSION P_UNRELATED P_NOWAIT);
+
+my $pl = $0;
+$pl =~ s/_kid\.t$/.t/i;
+die "Can't find the kid script" unless -r $pl;
+
+my $inc = $ENV{PERL5LIB};
+$inc = $ENV{PERLLIB} unless defined $inc;
+$inc = '' unless defined $inc;
+$ENV{PERL5LIB} = join ';', @INC, split /;/, $inc;
+
+# The thest in $pl modify the session too bad. We run the tests
+# in a different session to keep the current session cleaner
+
+# Apparently, this affects things at open() time, not at system() time
+$^F = 40;
+
+# These do not work... Apparently, the kid "interprets" file handles
+# open to CON as output to *its* CON (shortcut in the kernel via the
+# device flags?).
+
+#my @fh = ('<&STDIN', '>&STDOUT', '>&STDERR');
+#my @nfd;
+#open $nfd[$_], $fh[$_] or die "Cannot remap FH" for 0..2;
+#my @fn = map fileno $_, @nfd;
+#$ENV{NEW_FD} = "@fn";
+
+my ($stdout_r,$stdout_w,$stderr_r,$stderr_w);
+pipe $stderr_r, $stderr_w or die;
+
+# Duper for $stderr_r to STDERR
+my ($e_r, $e_w) = map fileno $_, $stderr_r, $stderr_w;
+my $k = system P_NOWAIT, $^X, '-we', <<'EOS', $e_r, $e_w or die "Cannot start a STDERR duper";
+ my ($e_r, $e_w) = @ARGV;
+ # close the other end by the implicit close:
+ { open my $closeit, ">&=$e_w" or die "kid: open >&=$e_w: $!, `$^E'" }
+ open IN, "<&=$e_r" or die "kid: open <&=$e_r: $!, `$^E'";
+ select STDERR; $| = 1; print while sysread IN, $_, 1<<16;
+EOS
+close $stderr_r or die; # Now the kid is the owner
+
+pipe $stdout_r, $stdout_w or die;
+
+my @fn = (map fileno $_, $stdout_w, $stderr_w);
+$ENV{NEW_FD} = "@fn";
+# print "# fns=@fn\n";
+
+$ENV{OS2_PROCESS_TEST_SEPARATE_SESSION} = 1;
+my $pid = system P_SESSION, $^X, $pl, @ARGV or die;
+close $stderr_w or die; # Leave these two FH to the kid only
+close $stdout_w or die;
+
+# Duplicate the STDOUT of the kid:
+# These are workarounds for bug in sysread: it is reading in binary...
+binmode $stdout_r;
+binmode STDOUT;
+$| = 1; print while sysread $stdout_r, $_, 1<<16;
+
+waitpid($pid, 0) >= 0 or die;
+
+# END { print "# parent finished\r\n" }
diff --git a/os2/OS2/Process/t/os2_process_text.t b/os2/OS2/Process/t/os2_process_text.t
new file mode 100644
index 0000000000..7367327ca4
--- /dev/null
+++ b/os2/OS2/Process/t/os2_process_text.t
@@ -0,0 +1,52 @@
+#! /usr/bin/perl -w
+
+BEGIN {
+ my $inc = $ENV{PERL5LIB};
+ $inc = $ENV{PERLLIB} unless defined $inc;
+ $inc = '' unless defined $inc;
+ $ENV{PERL5LIB} = join ';', @INC, split /;/, $inc;
+}
+
+use strict;
+use Test::More tests => 11;
+use OS2::Process;
+
+my $cmd = <<'EOA';
+use OS2::Process;
+$| = 1;
+print for $$, ppid, sidOf;
+$SIG{TERM} = $SIG{INT} = sub {exit};
+sleep 10;
+EOA
+
+#my $PID = open my $fh, '-|', $^X, '-wle', $cmd;
+$ENV{CMD_RUN} = $cmd;
+my $PID = open my $fh, '-|', "$^X -wle 'eval \$ENV{CMD_RUN} or die'";
+ok $PID, 'opened a pipe';
+my ($kpid, $kppid, $sid);
+$kpid = <$fh>;
+$kppid = <$fh>;
+$sid = <$fh>;
+chomp ($kpid, $kppid, $sid);
+
+# This does not work with the intervening shell...
+my $extra_fork = $kppid == $PID; # Temporary implementation of multi-arg open()
+
+print "# us=$$, immediate-pid=$PID, parent-of-kid=$kppid, kid=$kpid\n";
+if ($ENV{CMD_RUN}) { # Two copies of the shell intervene...
+ is( ppidOf($kppid), $PID, 'correct pid of the kid or its parent');
+ is( ppidOf($PID), $$, 'we know our child\'s parent');
+} else {
+ is( ($extra_fork ? $kppid : $kpid), $PID, 'correct pid of the kid');
+ is( $kppid, ($extra_fork ? $PID : $$), 'kid knows its ppid');
+}
+ok $sid >= 0, 'kid got its sid';
+is($sid, sidOf, 'sid of kid same as our');
+is(sidOf($kpid), $sid, 'we know sid of kid');
+is(sidOf($PID), $sid, 'we know sid of inter-kid');
+is(ppidOf($kpid), $kppid, 'we know ppid of kid');
+is(ppidOf($PID), $$, 'we know ppid of inter-kid');
+
+ok kill('TERM', $kpid), 'killed the kid';
+#ok( ($PID == $kpid or kill('TERM', $PID)), 'killed the inter-kid');
+ok close $fh, 'closed the pipe'; # No kid any more
diff --git a/os2/os2.c b/os2/os2.c
index 8a32ee4d8e..38da198434 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -276,10 +276,25 @@ static const struct {
{&pmwin_handle, NULL, 875}, /* WinSetWindowPos */
{&pmwin_handle, NULL, 877}, /* WinSetWindowText */
{&pmwin_handle, NULL, 883}, /* WinShowWindow */
- {&pmwin_handle, NULL, 872}, /* WinIsWindow */
+ {&pmwin_handle, NULL, 772}, /* WinIsWindow */
{&pmwin_handle, NULL, 899}, /* WinWindowFromId */
{&pmwin_handle, NULL, 900}, /* WinWindowFromPoint */
{&pmwin_handle, NULL, 919}, /* WinPostMsg */
+ {&pmwin_handle, NULL, 735}, /* WinEnableWindow */
+ {&pmwin_handle, NULL, 736}, /* WinEnableWindowUpdate */
+ {&pmwin_handle, NULL, 773}, /* WinIsWindowEnabled */
+ {&pmwin_handle, NULL, 774}, /* WinIsWindowShowing */
+ {&pmwin_handle, NULL, 775}, /* WinIsWindowVisible */
+ {&pmwin_handle, NULL, 839}, /* WinQueryWindowPtr */
+ {&pmwin_handle, NULL, 843}, /* WinQueryWindowULong */
+ {&pmwin_handle, NULL, 844}, /* WinQueryWindowUShort */
+ {&pmwin_handle, NULL, 874}, /* WinSetWindowBits */
+ {&pmwin_handle, NULL, 876}, /* WinSetWindowPtr */
+ {&pmwin_handle, NULL, 878}, /* WinSetWindowULong */
+ {&pmwin_handle, NULL, 879}, /* WinSetWindowUShort */
+ {&pmwin_handle, NULL, 813}, /* WinQueryDesktopWindow */
+ {&pmwin_handle, NULL, 851}, /* WinSetActiveWindow */
+ {&doscalls_handle, NULL, 360}, /* DosQueryModFromEIP */
};
static PFN ExtFCN[C_ARR_LEN(loadOrdinals)]; /* Labeled by ord ORD_*. */
@@ -378,7 +393,7 @@ get_sysinfo(ULONG pid, ULONG flags)
if (pDosVerifyPidTid) { /* Warp3 or later */
/* Up to some fixpak QuerySysState() kills the system if a non-existent
pid is used. */
- if (!pDosVerifyPidTid(pid, 1))
+ if (CheckOSError(pDosVerifyPidTid(pid, 1)))
return 0;
}
New(1322, pbuffer, buf_len, char);
@@ -1467,6 +1482,20 @@ os2error(int rc)
return buf;
}
+void
+ResetWinError(void)
+{
+ WinError_2_Perl_rc;
+}
+
+void
+CroakWinError(int die, char *name)
+{
+ FillWinError;
+ if (die && Perl_rc)
+ croak("%s: %s", (name ? name : "Win* API call"), os2error(Perl_rc));
+}
+
char *
os2_execname(pTHX)
{
@@ -1561,8 +1590,9 @@ Perl_Register_MQ(int serve)
PPIB pib;
PTIB tib;
- if (Perl_os2_initial_mode++)
+ if (Perl_hmq_refcnt > 0)
return Perl_hmq;
+ Perl_hmq_refcnt = 0; /* Be extra safe */
DosGetInfoBlocks(&tib, &pib);
Perl_os2_initial_mode = pib->pib_ultype;
/* Try morphing into a PM application. */
@@ -2194,6 +2224,78 @@ XS(XS_Cwd_extLibpath_set)
XSRETURN(1);
}
+/* Input: Address, BufLen
+APIRET APIENTRY
+DosQueryModFromEIP (HMODULE * hmod, ULONG * obj, ULONG BufLen, PCHAR Buf,
+ ULONG * Offset, ULONG Address);
+*/
+
+DeclOSFuncByORD(APIRET, _DosQueryModFromEIP,ORD_DosQueryModFromEIP,
+ (HMODULE * hmod, ULONG * obj, ULONG BufLen, PCHAR Buf,
+ ULONG * Offset, ULONG Address),
+ (hmod, obj, BufLen, Buf, Offset, Address))
+
+enum module_name_how { mod_name_handle, mod_name_shortname, mod_name_full};
+
+static SV*
+module_name_at(void *pp, enum module_name_how how)
+{
+ char buf[MAXPATHLEN];
+ char *p = buf;
+ HMODULE mod;
+ ULONG obj, offset, rc;
+
+ if (!_DosQueryModFromEIP(&mod, &obj, sizeof(buf), buf, &offset, (ULONG)pp))
+ return &PL_sv_undef;
+ if (how == mod_name_handle)
+ return newSVuv(mod);
+ /* Full name... */
+ if ( how == mod_name_full
+ && CheckOSError(DosQueryModuleName(mod, sizeof(buf), buf)) )
+ return &PL_sv_undef;
+ while (*p) {
+ if (*p == '\\')
+ *p = '/';
+ p++;
+ }
+ return newSVpv(buf, 0);
+}
+
+static SV*
+module_name_of_cv(SV *cv, enum module_name_how how)
+{
+ if (!cv || !SvROK(cv) || SvTYPE(SvRV(cv)) != SVt_PVCV || !CvXSUB(SvRV(cv)))
+ croak("Not an XSUB reference");
+ return module_name_at(CvXSUB(SvRV(cv)), how);
+}
+
+/* Find module name to which *this* subroutine is compiled */
+#define module_name(how) module_name_at(&module_name_at, how)
+
+XS(XS_OS2_DLLname)
+{
+ dXSARGS;
+ if (items > 2)
+ Perl_croak(aTHX_ "Usage: OS2::DLLname( [ how, [\\&xsub] ] )");
+ {
+ SV * RETVAL;
+ int how;
+
+ if (items < 1)
+ how = mod_name_full;
+ else {
+ how = (int)SvIV(ST(0));
+ }
+ if (items < 2)
+ RETVAL = module_name(how);
+ else
+ RETVAL = module_name_of_cv(ST(1), how);
+ ST(0) = RETVAL;
+ sv_2mortal(ST(0));
+ }
+ XSRETURN(1);
+}
+
#define get_control87() _control87(0,0)
#define set_control87 _control87
@@ -2291,6 +2393,7 @@ Xs_OS2_init(pTHX)
newXSproto("OS2::_control87", XS_OS2__control87, file, "$$");
newXSproto("OS2::get_control87", XS_OS2_get_control87, file, "");
newXSproto("OS2::set_control87", XS_OS2_set_control87, file, ";$$");
+ newXSproto("OS2::DLLname", XS_OS2_DLLname, file, ";$$");
gv = gv_fetchpv("OS2::is_aout", TRUE, SVt_PV);
GvMULTI_on(gv);
#ifdef PERL_IS_AOUT
diff --git a/os2/os2_base.t b/os2/os2_base.t
index ceaeb3f9eb..bb4735a96e 100644
--- a/os2/os2_base.t
+++ b/os2/os2_base.t
@@ -1,3 +1,53 @@
+#!/usr/bin/perl -w
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Test::More tests => 24;
+use strict;
+use Config;
+
+my $cwd = Cwd::sys_cwd();
+ok 1;
+ok -d $cwd;
+
+my $lpb = Cwd::extLibpath;
+ok 1;
+$lpb .= ';' unless $lpb and $lpb =~ /;$/;
+
+my $lpe = Cwd::extLibpath(1);
+ok 1;
+$lpe .= ';' unless $lpe and $lpe =~ /;$/;
+
+ok Cwd::extLibpath_set("$lpb$cwd");
+
+$lpb = Cwd::extLibpath;
+ok 1;
+$lpb =~ s#\\#/#g;
+(my $s_cwd = $cwd) =~ s#\\#/#g;
+
+like($lpb, qr/\Q$s_cwd/);
+
+ok Cwd::extLibpath_set("$lpe$cwd", 1);
+
+$lpe = Cwd::extLibpath(1);
+ok 1;
+$lpe =~ s#\\#/#g;
+
+like($lpe, qr/\Q$s_cwd/);
+
+is(uc OS2::DLLname(1), uc $Config{dll_name});
+like(OS2::DLLname, qr#\Q/$Config{dll_name}\E\.dll$#i );
+(my $root_cwd = $s_cwd) =~ s,/t$,,;
+like(OS2::DLLname, qr#^\Q$root_cwd\E(/t)?\Q/$Config{dll_name}\E\.dll#i );
+is(OS2::DLLname, OS2::DLLname(2));
+like(OS2::DLLname(0), qr#^(\d+)$# );
+
+
+is(OS2::DLLname($_), OS2::DLLname($_, \&Cwd::extLibpath) ) for 0..2;
+ok(not defined eval { OS2::DLLname $_, \&Cwd::cwd; 1 } ) for 0..2;
+ok(not defined eval { OS2::DLLname $_, \&xxx; 1 } ) for 0..2;
print "1.." . lasttest() . "\n";
$cwd = Cwd::sys_cwd();
@@ -36,7 +86,7 @@ print "ok 10\n";
unshift @INC, 'lib';
require OS2::Process;
-@l = OS2::Process::process_entry();
+my @l = OS2::Process::process_entry();
print "not " unless @l == 11;
print "ok 11\n";
diff --git a/os2/os2ish.h b/os2/os2ish.h
index 034fe82836..d1c45ad86a 100644
--- a/os2/os2ish.h
+++ b/os2/os2ish.h
@@ -480,15 +480,30 @@ void init_PMWIN_entries(void);
/* INCL_DOSERRORS needed. rc should be declared outside. */
#define CheckOSError(expr) (!(rc = (expr)) ? 0 : (FillOSError(rc), 1))
/* INCL_WINERRORS needed. */
-#define SaveWinError(expr) ((expr) ? : (FillWinError, 0))
#define CheckWinError(expr) ((expr) ? 0: (FillWinError, 1))
+
+/* This form propagates the return value, setting $^E if needed */
+#define SaveWinError(expr) ((expr) ? : (FillWinError, 0))
+
+/* This form propagates the return value, dieing with $^E if needed */
+#define SaveCroakWinError(expr,die,name1,name2) \
+ ((expr) ? : (CroakWinError(die,name1 name2), 0))
+
#define FillOSError(rc) (os2_setsyserrno(rc), \
Perl_severity = SEVERITY_ERROR)
+#define WinError_2_Perl_rc \
+ ( init_PMWIN_entries(), \
+ Perl_rc=(*PMWIN_entries.GetLastError)(perl_hab_GET()) )
+
+/* Calling WinGetLastError() resets the error code of the current thread.
+ Since for some Win* API return value 0 is normal, one needs to call
+ this before calling them to distinguish normal and anomalous returns. */
+/*#define ResetWinError() WinError_2_Perl_rc */
+
/* At this moment init_PMWIN_entries() should be a nop (WinInitialize should
be called already, right?), so we do not risk stepping over our own error */
-#define FillWinError ( init_PMWIN_entries(), \
- Perl_rc=(*PMWIN_entries.GetLastError)(perl_hab_GET()),\
+#define FillWinError ( WinError_2_Perl_rc, \
Perl_severity = ERRORIDSEV(Perl_rc), \
Perl_rc = ERRORIDERROR(Perl_rc), \
os2_setsyserrno(Perl_rc))
@@ -559,6 +574,21 @@ enum entries_ordinals {
ORD_WinWindowFromId,
ORD_WinWindowFromPoint,
ORD_WinPostMsg,
+ ORD_WinEnableWindow,
+ ORD_WinEnableWindowUpdate,
+ ORD_WinIsWindowEnabled,
+ ORD_WinIsWindowShowing,
+ ORD_WinIsWindowVisible,
+ ORD_WinQueryWindowPtr,
+ ORD_WinQueryWindowULong,
+ ORD_WinQueryWindowUShort,
+ ORD_WinSetWindowBits,
+ ORD_WinSetWindowPtr,
+ ORD_WinSetWindowULong,
+ ORD_WinSetWindowUShort,
+ ORD_WinQueryDesktopWindow,
+ ORD_WinSetActiveWindow,
+ ORD_DosQueryModFromEIP,
ORD_NENTRIES
};
@@ -577,6 +607,44 @@ enum entries_ordinals {
#define AssignFuncPByORD(p,o) (*(Perl_PFN*)&(p) = (loadByOrdinal(o, 1)))
+/* This flavor caches the procedure pointer (named as p__Win#name) locally */
+#define DeclWinFuncByORD_CACHE(ret,name,o,at,args) \
+ DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,0,1)
+
+/* This flavor may reset the last error before the call (if ret=0 may be OK) */
+#define DeclWinFuncByORD_CACHE_resetError(ret,name,o,at,args) \
+ DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,1,1)
+
+/* Two flavors below do the same as above, but do not auto-croak */
+/* This flavor caches the procedure pointer (named as p__Win#name) locally */
+#define DeclWinFuncByORD_CACHE_survive(ret,name,o,at,args) \
+ DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,0,0)
+
+/* This flavor may reset the last error before the call (if ret=0 may be OK) */
+#define DeclWinFuncByORD_CACHE_resetError_survive(ret,name,o,at,args) \
+ DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,1,0)
+
+#define DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,r,die) \
+ static ret (*CAT2(p__Win,name)) at; \
+ static ret name at { \
+ if (!CAT2(p__Win,name)) \
+ AssignFuncPByORD(CAT2(p__Win,name), o); \
+ if (r) ResetWinError(); \
+ return SaveCroakWinError(CAT2(p__Win,name) args, die, "[Win]", STRINGIFY(name)); }
+
+/* These flavors additionally assume ORD is name with prepended ORD_Win */
+#define DeclWinFunc_CACHE(ret,name,at,args) \
+ DeclWinFuncByORD_CACHE(ret,name,CAT2(ORD_Win,name),at,args)
+#define DeclWinFunc_CACHE_resetError(ret,name,at,args) \
+ DeclWinFuncByORD_CACHE_resetError(ret,name,CAT2(ORD_Win,name),at,args)
+#define DeclWinFunc_CACHE_survive(ret,name,at,args) \
+ DeclWinFuncByORD_CACHE_survive(ret,name,CAT2(ORD_Win,name),at,args)
+#define DeclWinFunc_CACHE_resetError_survive(ret,name,at,args) \
+ DeclWinFuncByORD_CACHE_resetError_survive(ret,name,CAT2(ORD_Win,name),at,args)
+
+void ResetWinError(void);
+void CroakWinError(int die, char *name);
+
#define PERLLIB_MANGLE(s, n) perllib_mangle((s), (n))
char *perllib_mangle(char *, unsigned int);