OS/2 tests and more
Ilya Zakharevich [Fri, 15 Feb 2002 03:56:24 +0000 (22:56 -0500)]
   Message-Id: <20020215035624.A16467@math.ohio-state.edu>
p4raw-link: @14577 on //depot/perl: 0ad5258ff3f3328f321188cbb4fcd6a74b365431

p4raw-id: //depot/perl@14705

13 files changed:
MANIFEST
configpm
hints/os2.sh
makedef.pl
os2/OS2/Process/Makefile.PL
os2/OS2/Process/Process.pm
os2/OS2/Process/Process.xs
os2/OS2/Process/t/os2_process.t [new file with mode: 0644]
os2/OS2/Process/t/os2_process_kid.t [new file with mode: 0644]
os2/OS2/Process/t/os2_process_text.t [new file with mode: 0644]
os2/os2.c
os2/os2_base.t
os2/os2ish.h

index 33ad2f6..4eda273 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1838,6 +1838,9 @@ os2/OS2/Process/Makefile.PL       system() constants in a module
 os2/OS2/Process/MANIFEST       system() constants in a module
 os2/OS2/Process/Process.pm     system() constants in a module
 os2/OS2/Process/Process.xs     system() constants in a module
+os2/OS2/Process/t/os2_process.t        Tests
+os2/OS2/Process/t/os2_process_kid.t    Tests
+os2/OS2/Process/t/os2_process_text.t   Tests
 os2/OS2/REXX/Changes           DLL access module
 os2/OS2/REXX/DLL/Changes       DLL access module
 os2/OS2/REXX/DLL/DLL.pm                DLL access module
index 6216f85..9f1a2e1 100755 (executable)
--- a/configpm
+++ b/configpm
@@ -277,6 +277,17 @@ if ($OS2::is_aout) {
 $preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
 sub TIEHASH { bless {%preconfig} }
 ENDOFSET
+  # Extract the name of the DLL from the makefile to avoid duplication
+  my ($f) = grep -r, qw(GNUMakefile Makefile);
+  my $dll;
+  if (open my $fh, '<', $f) {
+    while (<$fh>) {
+      $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
+    }
+  }
+  print CONFIG <<ENDOFSET if $dll;
+\$preconfig{dll_name} = '$dll';
+ENDOFSET
 } else {
   print CONFIG <<'ENDOFSET';
 sub TIEHASH { bless {} }
index 8633f26..9c1355c 100644 (file)
@@ -472,3 +472,4 @@ esac
 
 # Now go back
 cd ../..
+cp os2/*.t t/lib
index 2d7057b..c6a5355 100644 (file)
@@ -334,6 +334,9 @@ elsif ($PLATFORM eq 'os2') {
                    Perl_hab_GET
                    loadByOrdinal
                    pExtFCN
+                   os2error
+                   ResetWinError
+                   CroakWinError
                    )]);
 }
 elsif ($PLATFORM eq 'MacOS') {
index c141757..6a59d1f 100644 (file)
@@ -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"),
index 3015430..29e4d9b 100644 (file)
@@ -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
index 159ef49..1e75951 100644 (file)
@@ -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 (file)
index 0000000..f171047
--- /dev/null
@@ -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 (file)
index 0000000..7551d41
--- /dev/null
@@ -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 (file)
index 0000000..7367327
--- /dev/null
@@ -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
index 8a32ee4..38da198 100644 (file)
--- 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
index ceaeb3f..bb4735a 100644 (file)
@@ -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";
 
index 034fe82..d1c45ad 100644 (file)
@@ -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);