OS/2 improvements
Ilya Zakharevich [Thu, 28 Jun 2001 16:03:14 +0000 (12:03 -0400)]
Message-ID: <20010628160314.A17906@math.ohio-state.edu>

p4raw-id: //depot/perl@11010

12 files changed:
MANIFEST
hints/os2.sh
makedef.pl
os2/OS2/PrfDB/PrfDB.xs
os2/OS2/Process/Process.pm
os2/OS2/Process/Process.xs
os2/OS2/REXX/REXX.xs
os2/dl_os2.c
os2/dlfcn.h
os2/os2.c
os2/os2_base.t [new file with mode: 0644]
os2/os2ish.h

index b9119d0..0a9f2c3 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1544,6 +1544,7 @@ os2/dl_os2.c                      Addon for dl_open
 os2/Makefile.SHs               Shared library generation for OS/2
 os2/os2.c                      Additional code for OS/2
 os2/os2.sym                    Additional symbols to export
+os2/os2_base.t                 Additional tests for builtin methods
 os2/OS2/ExtAttr/Changes                EA access module
 os2/OS2/ExtAttr/ExtAttr.pm     EA access module
 os2/OS2/ExtAttr/ExtAttr.xs     EA access module
index 9be6f00..126f611 100644 (file)
@@ -437,6 +437,7 @@ cp -rfu * ../../ext/OS2/
 
 # Install tests:
 
+cp -uf ../*.t ../../t/lib
 for xxx in * ; do
        if $test -d $xxx/t; then
                cp -uf $xxx/t/*.t ../../t/lib
index 4fe193b..9c8a65e 100644 (file)
@@ -342,6 +342,8 @@ elsif ($PLATFORM eq 'os2') {
                    init_PMWIN_entries
                    PMWIN_entries
                    Perl_hab_GET
+                   loadByOrdinal
+                   pExtFCN
                    )]);
 }
 elsif ($PLATFORM eq 'MacOS') {
index e747fcf..bc4661a 100644 (file)
@@ -11,8 +11,30 @@ extern "C" {
 }
 #endif
 
-#define Prf_Open(pszFileName) SaveWinError(PrfOpenProfile(Perl_hab, (pszFileName)))
-#define Prf_Close(hini) (!CheckWinError(PrfCloseProfile(hini)))
+#define Prf_Open(pszFileName) SaveWinError(pPrfOpenProfile(Perl_hab, (pszFileName)))
+#define Prf_Close(hini) (!CheckWinError(pPrfCloseProfile(hini)))
+
+BOOL (*pPrfCloseProfile) (HINI hini);
+HINI (*pPrfOpenProfile) (HAB hab, PCSZ pszFileName);
+BOOL (*pPrfQueryProfile) (HAB hab, PPRFPROFILE pPrfProfile);
+BOOL (*pPrfQueryProfileData) (HINI hini, PCSZ pszApp, PCSZ pszKey, PVOID pBuffer,
+    PULONG pulBufferLength);
+/*
+LONG (*pPrfQueryProfileInt) (HINI hini, PCSZ pszApp, PCSZ pszKey, LONG  sDefault);
+ */
+BOOL (*pPrfQueryProfileSize) (HINI hini, PCSZ pszApp, PCSZ pszKey,
+    PULONG pulReqLen);
+/*
+ULONG (*pPrfQueryProfileString) (HINI hini, PCSZ pszApp, PCSZ pszKey,
+    PCSZ pszDefault, PVOID pBuffer, ULONG ulBufferLength);
+ */
+BOOL (*pPrfReset) (HAB hab, __const__ PRFPROFILE *pPrfProfile);
+BOOL (*pPrfWriteProfileData) (HINI hini, PCSZ pszApp, PCSZ pszKey,
+    CPVOID pData, ULONG ulDataLength);
+/*
+BOOL (*pPrfWriteProfileString) (HINI hini, PCSZ pszApp, PCSZ pszKey,
+    PCSZ pszData);
+ */
 
 SV *
 Prf_Get(pTHX_ HINI hini, PSZ app, PSZ key) {
@@ -20,10 +42,10 @@ Prf_Get(pTHX_ HINI hini, PSZ app, PSZ key) {
     BOOL rc;
     SV *sv;
 
-    if (CheckWinError(PrfQueryProfileSize(hini, app, key, &len))) return &PL_sv_undef;
+    if (CheckWinError(pPrfQueryProfileSize(hini, app, key, &len))) return &PL_sv_undef;
     sv = newSVpv("", 0);
     SvGROW(sv, len + 1);
-    if (CheckWinError(PrfQueryProfileData(hini, app, key, SvPVX(sv), &len))
+    if (CheckWinError(pPrfQueryProfileData(hini, app, key, SvPVX(sv), &len))
        || (len == 0 && (app == NULL || key == NULL))) { /* Somewhy needed. */
        SvREFCNT_dec(sv);
        return &PL_sv_undef;
@@ -37,12 +59,12 @@ I32
 Prf_GetLength(HINI hini, PSZ app, PSZ key) {
     U32 len;
 
-    if (CheckWinError(PrfQueryProfileSize(hini, app, key, &len))) return -1;
+    if (CheckWinError(pPrfQueryProfileSize(hini, app, key, &len))) return -1;
     return len;
 }
 
 #define Prf_Set(hini, app, key, s, l)                  \
-        (!(CheckWinError(PrfWriteProfileData(hini, app, key, s, l))))
+        (!(CheckWinError(pPrfWriteProfileData(hini, app, key, s, l))))
 
 #define Prf_System(key)                                        \
        ( (key) ? ( (key) == 1  ? HINI_USERPROFILE      \
@@ -59,7 +81,7 @@ Prf_Profiles(pTHX)
     char system[257];
     PRFPROFILE info = { 257, user, 257, system};
     
-    if (CheckWinError(PrfQueryProfile(Perl_hab, &info))) return &PL_sv_undef;
+    if (CheckWinError(pPrfQueryProfile(Perl_hab, &info))) return &PL_sv_undef;
     if (info.cchUserName > 257 || info.cchSysName > 257)
        die("Panic: Profile names too long");
     av_push(av, newSVpv(user, info.cchUserName - 1));
@@ -78,12 +100,12 @@ Prf_SetUser(pTHX_ SV *sv)
     
     if (!SvPOK(sv)) die("User profile name not defined");
     if (SvCUR(sv) > 256) die("User profile name too long");
-    if (CheckWinError(PrfQueryProfile(Perl_hab, &info))) return 0;
+    if (CheckWinError(pPrfQueryProfile(Perl_hab, &info))) return 0;
     if (info.cchSysName > 257)
        die("Panic: System profile name too long");
     info.cchUserName = SvCUR(sv) + 1;
     info.pszUserName = SvPVX(sv);
-    return !CheckWinError(PrfReset(Perl_hab, &info));
+    return !CheckWinError(pPrfReset(Perl_hab, &info));
 }
 
 MODULE = OS2::PrfDB            PACKAGE = OS2::Prf PREFIX = Prf_
@@ -141,3 +163,11 @@ OUTPUT:
 
 BOOT:
        Acquire_hab();
+       AssignFuncPByORD(pPrfQueryProfileSize,  ORD_PRF32QUERYPROFILESIZE);
+       AssignFuncPByORD(pPrfOpenProfile,       ORD_PRF32OPENPROFILE);
+       AssignFuncPByORD(pPrfCloseProfile,      ORD_PRF32CLOSEPROFILE);
+       AssignFuncPByORD(pPrfQueryProfile,      ORD_PRF32QUERYPROFILE);
+       AssignFuncPByORD(pPrfReset,             ORD_PRF32RESET);
+       AssignFuncPByORD(pPrfQueryProfileData,  ORD_PRF32QUERYPROFILEDATA);
+       AssignFuncPByORD(pPrfWriteProfileData,  ORD_PRF32WRITEPROFILEDATA);
+
index b862885..6ce93c0 100644 (file)
@@ -1,12 +1,20 @@
+package OS2::localMorphPM;
+
+sub new { my ($c,$f) = @_; OS2::MorphPM($f); bless [shift], $c }
+sub DESTROY { OS2::UnMorphPM(shift->[0]) }
+
 package OS2::Process;
 
-$VERSION = 0.2;
+BEGIN {
+  require Exporter;
+  require DynaLoader;
+  #require AutoLoader;
 
-require Exporter;
-require DynaLoader;
-#require AutoLoader;
+  @ISA = qw(Exporter DynaLoader);
+  $VERSION = "1.0";
+  bootstrap OS2::Process;
+}
 
-@ISA = qw(Exporter DynaLoader);
 # 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.
@@ -43,10 +51,51 @@ require DynaLoader;
        T_VIRTDRV
        T_PROTDLL
        T_32BIT
+       ppid
+       ppidOf
+       sidOf
+       scrsize
+       scrsize_set
        process_entry
-       set_title
-       get_title
+       process_entries
+       process_hentry
+       process_hentries
+       change_entry
+       change_entryh
+       Title_set
+       Title
+       WindowText
+       WindowText_set
+       WindowPos
+       WindowPos_set
+       WindowProcess
+       SwitchToProgram
+       ActiveWindow
+       ClassName
+       FocusWindow
+       FocusWindow_set
+       ShowWindow
+       PostMsg
+       BeginEnumWindows
+       EndEnumWindows
+       GetNextWindow
+       IsWindow
+       ChildWindows
+       out_codepage
+       out_codepage_set
+       in_codepage
+       in_codepage_set
+       cursor
+       cursor_set
+       screen
+       screen_set
+       process_codepages
+       QueryWindow
+       WindowFromId
+       WindowFromPoint
+       EnumDlgItem
 );
+
 sub AUTOLOAD {
     # This AUTOLOAD is used to 'autoload' constants from the constant()
     # XS function.  If a constant is not found then control is passed
@@ -70,11 +119,111 @@ sub AUTOLOAD {
     goto &$AUTOLOAD;
 }
 
-bootstrap OS2::Process;
-
 # Preloaded methods go here.
 
-sub get_title () { (process_entry())[0] }
+sub Title () { (process_entry())[0] }
+
+# *Title_set = \&sesmgr_title_set;
+
+sub swTitle_set_sw {
+  my ($title, @sw) = @_;
+  $sw[0] = $title;
+  change_entry(@sw);
+}
+
+sub swTitle_set {
+  my (@sw) = process_entry();
+  swTitle_set_sw(shift, @sw);
+}
+
+sub winTitle_set_sw {
+  my ($title, @sw) = @_;
+  my $h = OS2::localMorphPM->new(0);
+  WindowText_set $sw[1], $title;
+}
+
+sub winTitle_set {
+  my (@sw) = process_entry();
+  winTitle_set_sw(shift, @sw);
+}
+
+sub bothTitle_set {
+  my (@sw) = process_entry();
+  my $t = shift;
+  winTitle_set_sw($t, @sw);
+  swTitle_set_sw($t, @sw);
+}
+
+sub Title_set {
+  my $t = shift;
+  return 1 if sesmgr_title_set($t);
+  return 0 unless $^E == 372;
+  my (@sw) = process_entry();
+  winTitle_set_sw($t, @sw);
+  swTitle_set_sw($t, @sw);
+}
+
+sub process_entry { swentry_expand(process_swentry(@_)) }
+
+our @hentry_fields = qw( title owner_hwnd icon_hwnd 
+                        owner_phandle owner_pid owner_sid
+                        visible nonswitchable jumpable ptype sw_entry );
+
+sub swentry_hexpand ($) {
+  my %h;
+  @h{@hentry_fields} = swentry_expand(shift);
+  \%h;
+}
+
+sub process_hentry { swentry_hexpand(process_swentry(@_)) }
+
+my $swentry_size = swentry_size();
+
+sub sw_entries () {
+  my $s = swentries_list();
+  my ($c, $s1) = unpack 'La*', $s;
+  die "Unconsistent size in swentries_list()" unless 4+$c*$swentry_size == length $s;
+  my (@l, $e);
+  push @l, $e while $e = substr $s1, 0, $swentry_size, '';
+  @l;
+}
+
+sub process_entries () {
+  map [swentry_expand($_)], sw_entries;
+}
+
+sub process_hentries () {
+  map swentry_hexpand($_), sw_entries;
+}
+
+sub change_entry {
+  change_swentry(create_swentry(@_));
+}
+
+sub create_swentryh ($) {
+  my $h = shift;
+  create_swentry(@$h{@hentry_fields});
+}
+
+sub change_entryh ($) {
+  change_swentry(create_swentryh(shift));
+}
+
+# Massage entries into the same order as WindowPos_set:
+sub WindowPos ($) {
+  my ($fl, $w, $h, $x, $y, $behind, $hwnd, @rest)
+       = unpack 'L l4 L4', WindowSWP(shift);
+  ($x, $y, $fl, $w, $h, $behind, @rest);
+}
+
+sub ChildWindows ($) {
+  my @kids;
+  my $h = BeginEnumWindows shift;
+  my $w;
+  push @kids, $w while $w = GetNextWindow $h;
+  EndEnumWindows $h;
+  @kids;
+}
 
 # Autoload methods go after __END__, and are processed by the autosplit program.
 
@@ -83,15 +232,17 @@ __END__
 
 =head1 NAME
 
-OS2::Process - exports constants for system() call on OS2.
+OS2::Process - exports constants for system() call, and process control on OS2.
 
 =head1 SYNOPSIS
 
     use OS2::Process;
-    $pid = system(P_PM+P_BACKGROUND, "epm.exe");
+    $pid = system(P_PM | P_BACKGROUND, "epm.exe");
 
 =head1 DESCRIPTION
 
+=head2 Optional argument to system()
+
 the builtin function system() under OS/2 allows an optional first
 argument which denotes the mode of the process. Note that this argument is
 recognized only if it is strictly numerical.
@@ -123,14 +274,21 @@ and optionally add PM and session option bits:
 
 =head2 Access to process properties
 
-Additionaly, subroutines my_type(), process_entry() and
-C<file_type(file)>, get_title() and C<set_title(newtitle)> are implemented.  
-my_type() returns the type of the current process (one of 
-"FS", "DOS", "VIO", "PM", "DETACH" and "UNKNOWN"), or C<undef> on error.
+On OS/2 processes have the usual I<parent/child> semantic;
+additionally, there is a hierarchy of sessions with their own
+I<parent/child> tree.  A session is either a FS session, or a windowed
+pseudo-session created by PM.  A session is a "unit of user
+interaction", a change to in/out settings in one of them does not
+affect other sessions.
 
 =over
 
-=item C<file_type(file)> 
+=item my_type()
+
+returns the type of the current process (one of
+"FS", "DOS", "VIO", "PM", "DETACH" and "UNKNOWN"), or C<undef> on error.
+
+=item C<file_type(file)>
 
 returns the type of the executable file C<file>, or
 dies on error.  The bits 0-2 of the result contain one of the values
@@ -139,15 +297,15 @@ dies on error.  The bits 0-2 of the result contain one of the values
 
 =item C<T_NOTSPEC> (0)
 
-Application type is not specified in the executable header. 
+Application type is not specified in the executable header.
 
 =item C<T_NOTWINDOWCOMPAT> (1)
 
-Application type is not-window-compatible. 
+Application type is not-window-compatible.
 
 =item C<T_WINDOWCOMPAT> (2)
 
-Application type is window-compatible. 
+Application type is window-compatible.
 
 =item C<T_WINDOWAPI> (3)
 
@@ -177,11 +335,11 @@ and 4 will be set to 0.
 
 =item C<T_PHYSDRV> (0x40)
 
-Set to 1 if the executable file is a physical device driver. 
+Set to 1 if the executable file is a physical device driver.
 
 =item C<T_VIRTDRV> (0x80)
 
-Set to 1 if the executable file is a virtual device driver. 
+Set to 1 if the executable file is a virtual device driver.
 
 =item C<T_PROTDLL> (0x100)
 
@@ -190,7 +348,7 @@ library module.
 
 =item C<T_32BIT> (0x4000)
 
-Set to 1 for 32-bit executable files. 
+Set to 1 for 32-bit executable files.
 
 =back
 
@@ -200,37 +358,127 @@ conditions.  If given non-absolute path, will look on C<PATH>, will
 add extention F<.exe> if no extension is present (add extension F<.>
 to suppress).
 
+=item C<@list = process_codepages()>
+
+the first element is the currently active codepage, up to 2 additional
+entries specify the system's "prepared codepages": the codepages the
+user can switch to.  The active codepage of a process is one of the
+prepared codepages of the system (if present).
+
+=item C<process_codepage_set($cp)>
+
+sets the currently active codepage.  [Affects printer output, in/out
+codepages of sessions started by this process, and the default
+codepage for drawing in PM; is inherited by kids.  Does not affect the
+out- and in-codepages of the session.]
+
+=item ppid()
+
+returns the PID of the parent process.
+
+=item C<ppidOf($pid = $$)>
+
+returns the PID of the parent process of $pid.  -1 on error.
+
+=item C<sidOf($pid = $$)>
+
+returns the session id of the process id $pid.  -1 on error.
+
+=back
+
+=head2 Control of VIO sessions
+
+VIO applications are applications running in a text-mode session.
+
+=over
+
+=item out_codepage()
+
+gets code page used for screen output (glyphs).  -1 means that a user font
+was loaded.
+
+=item C<out_codepage_set($cp)>
+
+sets code page used for screen output (glyphs).  -1 switches to a preloaded
+user font.  -2 switches off the preloaded user font.
+
+=item in_codepage()
+
+gets code page used for keyboard input.  0 means that a hardware codepage
+is used.
+
+=item C<in_codepage_set($cp)>
+
+sets code page used for keyboard input.
+
+=item C<($w, $h) = scrsize()>
+
+width and height of the given console window in character cells.
+
+=item C<scrsize_set([$w, ] $h)>
+
+set height (and optionally width) of the given console window in
+character cells.  Use 0 size to keep the old size.
+
+=item C<($s, $e, $w, $a) = cursor()>
+
+gets start/end lines of the blinking cursor in the charcell, its width
+(1 on text modes) and attribute (-1 for hidden, in text modes other
+values mean visible, in graphic modes color).
+
+=item C<cursor_set($s, $e, [$w [, $a]])>
+
+sets start/end lines of the blinking cursor in the charcell.  Negative
+values mean percents of the character cell height.
+
+=item screen()
+
+gets a buffer with characters and attributes of the screen.
+
+=item C<screen_set($buffer)>
+
+restores the screen given the result of screen().
+
+=back
+
+=head2 Control of the process list
+
+With the exception of Title_set(), all these calls require that PM is
+running, they would not work under alternative Session Managers.
+
+=over
+
 =item process_entry()
 
 returns a list of the following data:
 
 =over
 
-=item 
+=item
 
 Title of the process (in the C<Ctrl-Esc> list);
 
-=item 
+=item
 
 window handle of switch entry of the process (in the C<Ctrl-Esc> list);
 
-=item 
+=item
 
 window handle of the icon of the process;
 
-=item 
+=item
 
 process handle of the owner of the entry in C<Ctrl-Esc> list;
 
-=item 
+=item
 
 process id of the owner of the entry in C<Ctrl-Esc> list;
 
-=item 
+=item
 
 session id of the owner of the entry in C<Ctrl-Esc> list;
 
-=item 
+=item
 
 whether visible in C<Ctrl-Esc> list;
 
@@ -239,20 +487,20 @@ whether visible in C<Ctrl-Esc> list;
 whether item cannot be switched to (note that it is not actually
 grayed in the C<Ctrl-Esc> list));
 
-=item 
+=item
 
 whether participates in jump sequence;
 
-=item 
+=item
 
-program type.  Possible values are: 
+program type.  Possible values are:
 
-     PROG_DEFAULT                       0 
-     PROG_FULLSCREEN                    1 
-     PROG_WINDOWABLEVIO                 2 
-     PROG_PM                            3 
-     PROG_VDM                           4 
-     PROG_WINDOWEDVDM                   7 
+     PROG_DEFAULT                       0
+     PROG_FULLSCREEN                    1
+     PROG_WINDOWABLEVIO                 2
+     PROG_PM                            3
+     PROG_VDM                           4
+     PROG_WINDOWEDVDM                   7
 
 Although there are several other program types for WIN-OS/2 programs,
 these do not show up in this field. Instead, the PROG_VDM or
@@ -263,31 +511,351 @@ is a windowed WIN-OS/2 program, it runs in a PROG_WINDOWEDVDM
 session. Likewise, if it's a full-screen WIN-OS/2 program, it runs in
 a PROG_VDM session.
 
+=item
+
+switch-entry handle.
 
 =back
 
-=item C<set_title(newtitle)> 
+Optional arguments: the pid and the window-handle of the application running
+in the OS/2 session to query.
+
+=item process_hentry()
+
+similar to process_entry(), but returns a hash reference, the keys being
+
+  title owner_hwnd icon_hwnd owner_phandle owner_pid owner_sid
+  visible nonswitchable jumpable ptype sw_entry
+
+(a copy of the list of keys is in @hentry_fields).
+
+=item process_entries()
 
-- does not work with some windows (if the title is set from the start).  
+similar to process_entry(), but returns a list of array reference for all
+the elements in the switch list (one controlling C<Ctrl-Esc> window).
+
+=item process_hentries()
+
+similar to process_hentry(), but returns a list of hash reference for all
+the elements in the switch list (one controlling C<Ctrl-Esc> window).
+
+=item change_entry()
+
+changes a process entry, arguments are the same as process_entry() returns.
+
+=item change_entryh()
+
+Similar to change_entry(), but takes a hash reference as an argument.
+
+=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().)
+
+=item C<Title_set(newtitle)>
+
+tries two different interfaces.  The Session Manager one does not work
+with some windows (if the title is set from the start).
 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 ;-).
+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.
+
+=item C<SwitchToProgram($sw_entry)>
+
+switch to session given by a switch list handle.
+
+Use of this function causes another window (and its related windows)
+of a PM session to appear on the front of the screen, or a switch to
+another session in the case of a non-PM program. In either case,
+the keyboard (and mouse for the non-PM case) input is directed to
+the new program.
+
+=back
+
+=head2 Control of the PM windows
+
+Some of these API's require sending a message to the specified window.
+In such a case the process needs to be a PM process, or to be morphed
+to a PM process via OS2::MorphPM().
+
+For a temporary morphing to PM use L<OS2::localMorphPM class>.
+
+Keep in mind that PM windows are engaged in 2 "orthogonal" window
+trees, as well as in the z-order list.
+
+One tree is given by the I<parent/child> relationship.  This
+relationship affects drawing (child is drawn relative to its parent
+(lower-left corner), and the drawing is clipped by the parent's
+boundary; parent may request that I<it's> drawing is clipped to be
+confined to the outsize of the childs and/or siblings' windows);
+hiding; minimizing/restoring; and destroying windows.
+
+Another tree (not necessarily connected?) is given by I<ownership>
+relationship.  Ownership relationship assumes cooperation of the
+engaged windows via passing messages on "important events"; e.g.,
+scrollbars send information messages when the "bar" is moved, menus
+send messages when an item is selected; frames
+move/hide/unhide/minimize/restore/change-z-order-of owned frames when
+the owner is moved/etc., and destroy the owned frames (even when these
+frames are not descendants) when the owner is destroyed; etc.  [An
+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.
+
+=over
+
+=item C<WindowText($hwnd)>
+
+gets "a text content" of a window.
+
+=item C<WindowText_set($hwnd, $text)>
+
+sets "a text content" of a window.
+
+=item C<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.
+
+=item C<WindowPos_set($hwnd, $x, $y, $flags = SWP_MOVE, $wid = 0, $h = 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)>
+
+gets I<PID> and I<TID> of the process associated to the window.
+
+=item ActiveWindow([$parentHwnd])
+
+gets the active subwindow's handle for $parentHwnd or desktop.
+Returns FALSE if none.
+
+=item C<ClassName($hwnd)>
+
+returns the class name of the window.
+
+If this window is of any of the preregistered WC_* classes the class
+name returned is in the form "#nnnnn", where "nnnnn" is a group
+of up to five digits that corresponds to the value of the WC_* class name
+constant.
+
+=item FocusWindow()
+
+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
+
+       WinShowWindow( wlhwnd, TRUE );
+       WinSetFocus( HWND_DESKTOP, wlhwnd );
+       WinSwitchToProgram(wlhswitch);
+
+
+=item C<ShowWindow($hwnd [, $show])>
+
+Set visible/hidden flag of the window.  Default: $show is TRUE.
+
+=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
+
+    /* Emulate `Restore' */
+    WinPostMsg(SwitchBlock.tswe[i].swctl.hwnd, WM_SYSCOMMAND,
+               MPFROMSHORT(SC_RESTORE),        0);
+
+    /* Emulate `Show-Contextmenu' (Double-Click-2) */
+    hwndParent = WinQueryFocus(HWND_DESKTOP);
+    hwndActive = WinQueryActiveWindow(hwndParent);
+    WinPostMsg(hwndActive, WM_CONTEXTMENU, MPFROM2SHORT(0,0), MPFROMLONG(0));
+
+    /* Emulate `Close' */
+    WinPostMsg(pSWB->aswentry[i].swctl.hwnd, WM_CLOSE, 0, 0);
+
+    /* Same but softer: */
+    WinPostMsg(hwndactive, WM_SAVEAPPLICATION, 0L, 0L);
+    WinPostMsg(hwndactive, WM_CLOSE, 0L, 0L));
+    WinPostMsg(hwndactive, WM_QUIT, 0L, 0L));
+
+=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.
+
+=item C<$kid_hwnd = GetNextWindow($eh)>
+
+gets the next kid in the list.  Gets 0 on error or when the list ends.
 
-=item get_title() 
+=item C<EndEnumWindows($eh)>
 
-is a shortcut implemented via process_entry().
+End enumeration and release the list.
+
+=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:
+
+  sub l {
+    my ($o,$h) = @_;
+    printf ' ' x $o . "%#x\n", $h;
+    l($o+2,$_) for ChildWindows $h;
+  }
+  l 0, $HWND_DESKTOP
+
+=item C<IsWindow($hwnd)>
+
+true if the window handle is still valid.
+
+=item C<QueryWindow($hwnd, $type)>
+
+gets the handle of a related window.  $type should be one of C<QW_*> constants.
+
+=item C<IsChild($hwnd, $parent)>
+
+return TRUE if $hwnd is a descendant of $parent.
+
+=item C<WindowFromId($hwnd, $id)>
+
+return a window handle of a child of $hwnd with the given $id.
+
+  hwndSysMenu = WinWindowFromID(hwndDlg, FID_SYSMENU);
+  WinSendMsg(hwndSysMenu, MM_SETITEMATTR,
+      MPFROM2SHORT(SC_CLOSE, TRUE),
+      MPFROM2SHORT(MIA_DISABLED, MIA_DISABLED));
+
+=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
+$hwndParent (defaults to desktop) if no suitable children are found,
+or 0 if the point is outside the parent.
+
+$x and $y are relative to $hwndParent.
+
+=item C<EnumDlgItem($dlgHwnd, $type [, $relativeHwnd])>
+
+gets a dialog item window handle for an item of type $type of $dlgHwnd
+relative to $relativeHwnd, which is descendant of $dlgHwnd.
+$relativeHwnd may be specified if $type is EDI_FIRSTTABITEM or
+EDI_LASTTABITEM.
+
+The return is always an immediate child of hwndDlg, even if hwnd is
+not an immediate child window.  $type may be
+
+=over
+
+=item EDI_FIRSTGROUPITEM
+
+First item in the same group.
+
+=item EDI_FIRSTTABITEM
+
+First item in dialog with style WS_TABSTOP. hwnd is ignored.
+
+=item EDI_LASTGROUPITEM
+
+Last item in the same group.
+
+=item EDI_LASTTABITEM
+
+Last item in dialog with style WS_TABSTOP. hwnd is ignored.
+
+=item EDI_NEXTGROUPITEM
+
+Next item in the same group. Wraps around to beginning of group when
+the end of the group is reached.
+
+=item EDI_NEXTTABITEM
+
+Next item with style WS_TABSTOP. Wraps around to beginning of dialog
+item list when end is reached.
+
+=item EDI_PREVGROUPITEM
+
+Previous item in the same group. Wraps around to end of group when the
+start of the group is reached. For information on the WS_GROUP style,
+see Window Styles.
+
+=item EDI_PREVTABITEM
+
+Previous item with style WS_TABSTOP. Wraps around to end of dialog
+item list when beginning is reached.
 
 =back
 
+=back
+
+=head1 OS2::localMorphPM class
+
+This class morphs the process to PM for the duration of the given context.
+
+  {
+    my $h = OS2::localMorphPM->new(0);
+    # Do something
+  }
+
+The argument has the same meaning as one to OS2::MorphPM().  Calls can
+nest with internal ones being NOPs.
+
+=head1 TODO
+
+Constants (currently one needs to get them looking in a header file):
+
+  HWND_*
+  WM_*                 /* Separate module? */
+  SC_*
+  SWP_*
+  WC_*
+  PROG_*
+  QW_*
+  EDI_*
+  WS_*
+
+Show/Hide, Enable/Disable (WinShowWindow(), WinIsWindowVisible(),
+WinEnableWindow(), WinIsWindowEnabled()).
+
+Maximize/minimize/restore via WindowPos_set(), check via checking
+WS_MAXIMIZED/WS_MINIMIZED flags (how to get them?).
+
+=head1 $^E
+
+the majority of the APIs of this module set $^E on failure (no matter
+whether they die() on failure or not).  By the semantic of PM API
+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 BUGS
+
+whether a given API dies or returns FALSE/empty-list on error may be
+confusing.  This may change in the future.
+
 =head1 AUTHOR
 
-Andreas Kaiser <ak@ananke.s.bawue.de>, 
+Andreas Kaiser <ak@ananke.s.bawue.de>,
 Ilya Zakharevich <ilya@math.ohio-state.edu>.
 
 =head1 SEE ALSO
 
-C<spawn*>() system calls.
+C<spawn*>() system calls, L<OS2::Proc> and L<OS2::WinObject> modules.
 
 =cut
index 16b494d..159ef49 100644 (file)
@@ -1,12 +1,18 @@
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
 #include <process.h>
 #define INCL_DOS
 #define INCL_DOSERRORS
+#define INCL_DOSNLS
+#define INCL_WINSWITCHLIST
+#define INCL_WINWINDOWMGR
+#define INCL_WININPUT
+#define INCL_VIO
+#define INCL_KBD
 #include <os2.h>
 
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
 static unsigned long
 constant(char *name, int arg)
 {
@@ -239,27 +245,247 @@ file_type(char *path)
     return apptype;
 }
 
+DeclFuncByORD(HSWITCH, myWinQuerySwitchHandle,  ORD_WinQuerySwitchHandle,
+                 (HWND hwnd, PID pid), (hwnd, pid))
+DeclFuncByORD(ULONG, myWinQuerySwitchEntry,  ORD_WinQuerySwitchEntry,
+                 (HSWITCH hsw, PSWCNTRL pswctl), (hsw, pswctl))
+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))
+
+
+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));
+
+int
+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)
+{
+    LONG l = QueryWindowTextLength(hwnd);
+    SV *sv = newSVpvn("", 0);
+    STRLEN n_a;
+
+    if (l == 0)
+       return sv;
+    SvGROW(sv, l + 1);
+    if (!pWinQueryWindowText)
+       AssignFuncPByORD(pWinQueryWindowText, ORD_WinQueryWindowText);
+    CheckWinError(l = pWinQueryWindowText(hwnd, l + 1, SvPV_force(sv, n_a)));
+    SvCUR_set(sv, l);
+    return sv;
+}
+
+SWP
+QueryWindowSWP_(HWND hwnd)
+{
+    SWP swp;
+
+    if (!pWinQueryWindowPos)
+       AssignFuncPByORD(pWinQueryWindowPos, ORD_WinQueryWindowPos);
+    if (CheckWinError(pWinQueryWindowPos(hwnd, &swp)))
+       croak("WinQueryWindowPos() error");
+    return swp;
+}
+
+SV *
+QueryWindowSWP(HWND hwnd)
+{
+    SWP swp = QueryWindowSWP_(hwnd);
+
+    return newSVpvn((char*)&swp, sizeof(swp));
+}
+
+SV *
+QueryClassName(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);
+    }
+    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;
+
+    ppl.x = x; ppl.y = y;
+    if (!pWinWindowFromPoint)
+       AssignFuncPByORD(pWinWindowFromPoint, ORD_WinWindowFromPoint);
+    return SaveWinError(pWinWindowFromPoint(hwnd, &ppl, fChildren));
+}
+
 static void
-fill_swcntrl(SWCNTRL *swcntrlp)
+fill_swentry(SWENTRY *swentryp, HWND hwnd, PID pid)
 {
         int rc;
-        PTIB ptib;
-        PPIB ppib;
         HSWITCH hSwitch;    
-        HWND hwndMe;
 
         if (!(_emx_env & 0x200)) 
             croak("switch_entry not implemented on DOS"); /* not OS/2. */
-        if (CheckOSError(DosGetInfoBlocks(&ptib, &ppib)))
-            croak("DosGetInfoBlocks err %ld", rc);
         if (CheckWinError(hSwitch = 
-                          WinQuerySwitchHandle(NULLHANDLE, 
-                                               (PID)ppib->pib_ulpid)))
+                          myWinQuerySwitchHandle(hwnd, pid)))
             croak("WinQuerySwitchHandle err %ld", Perl_rc);
-        if (CheckOSError(WinQuerySwitchEntry(hSwitch, swcntrlp)))
+        swentryp->hswitch = hSwitch;
+        if (CheckOSError(myWinQuerySwitchEntry(hSwitch, &swentryp->swctl)))
             croak("WinQuerySwitchEntry err %ld", rc);
 }
 
+static void
+fill_swentry_default(SWENTRY *swentryp)
+{
+       fill_swentry(swentryp, NULLHANDLE, getpid());
+}
+
 /* static ULONG (* APIENTRY16 pDosSmSetTitle)(ULONG, PSZ); */
 ULONG _THUNK_FUNCTION(DosSmSetTitle)(ULONG, PSZ);
 
@@ -267,14 +493,14 @@ ULONG _THUNK_FUNCTION(DosSmSetTitle)(ULONG, PSZ);
 static ULONG (*pDosSmSetTitle)(ULONG, PSZ);
 
 static void
-set_title(char *s)
+sesmgr_title_set(char *s)
 {
-    SWCNTRL swcntrl;
+    SWENTRY swentry;
     static HMODULE hdosc = 0;
     BYTE buf[20];
     long rc;
 
-    fill_swcntrl(&swcntrl);
+    fill_swentry_default(&swentry);
     if (!pDosSmSetTitle || !hdosc) {
        if (CheckOSError(DosLoadModule(buf, sizeof buf, "sesmgr", &hdosc)))
            croak("Cannot load SESMGR: no `%s'", buf);
@@ -297,17 +523,15 @@ set_title(char *s)
 #else /* !0 */
 
 static bool
-set_title(char *s)
+sesmgr_title_set(char *s)
 {
-    SWCNTRL swcntrl;
-    static HMODULE hdosc = 0;
-    BYTE buf[20];
+    SWENTRY swentry;
     long rc;
 
-    fill_swcntrl(&swcntrl);
+    fill_swentry_default(&swentry);
     rc = ((USHORT)
           (_THUNK_PROLOG (2+4);
-           _THUNK_SHORT (swcntrl.idSession);
+           _THUNK_SHORT (swentry.swctl.idSession);
            _THUNK_FLAT (s);
            _THUNK_CALL (DosSmSetTitle)));
 #if 0
@@ -336,6 +560,345 @@ set_title2(char *s)
 }
 #endif
 
+SV *
+process_swentry(unsigned long pid, unsigned long hwnd)
+{
+    SWENTRY swentry;
+
+    if (!(_emx_env & 0x200)) 
+            croak("process_swentry not implemented on DOS"); /* not OS/2. */
+    fill_swentry(&swentry, hwnd, pid);
+    return newSVpvn((char*)&swentry, sizeof(swentry));
+}
+
+SV *
+swentries_list()
+{
+    int num, n = 0;
+    STRLEN n_a;
+    PSWBLOCK pswblk;
+    SV *sv = newSVpvn("",0);
+
+    if (!(_emx_env & 0x200)) 
+            croak("swentries_list not implemented on DOS"); /* not OS/2. */
+    if (!pWinQuerySwitchList)
+       AssignFuncPByORD(pWinQuerySwitchList, ORD_WinQuerySwitchList);
+    num = pWinQuerySwitchList(0, NULL, 0);     /* HAB is not required */
+    if (!num)
+       croak("(Unknown) error during WinQuerySwitchList()");
+    /* Allow one extra entry to allow overflow detection (may happen
+       if the list has been changed). */
+    while (num > n) {
+       if (n == 0)
+           n = num + 1;
+       else
+           n = 2*num + 10;                     /* Enlarge quickly */
+       SvGROW(sv, sizeof(ULONG) + sizeof(SWENTRY) * n + 1);
+       pswblk = (PSWBLOCK) SvPV_force(sv, n_a);
+       num = pWinQuerySwitchList(0, pswblk, SvLEN(sv));
+    }
+    SvCUR_set(sv, sizeof(ULONG) + sizeof(SWENTRY) * num);
+    *SvEND(sv) = 0;
+    return sv;
+}
+
+SWENTRY
+swentry( char *title, HWND sw_hwnd, HWND icon_hwnd, HPROGRAM owner_phandle,
+        PID owner_pid, ULONG owner_sid, ULONG visible, ULONG nonswitchable,
+        ULONG jumpable, ULONG ptype, HSWITCH sw_entry)
+{
+  SWENTRY e;
+
+  strncpy(e.swctl.szSwtitle, title, MAXNAMEL);
+  e.swctl.szSwtitle[60] = 0;
+  e.swctl.hwnd = sw_hwnd;
+  e.swctl.hwndIcon = icon_hwnd;
+  e.swctl.hprog = owner_phandle;
+  e.swctl.idProcess = owner_pid;
+  e.swctl.idSession = owner_sid;
+  e.swctl.uchVisibility = ((visible ? SWL_VISIBLE : SWL_INVISIBLE)
+                          | (nonswitchable ? SWL_GRAYED : 0));
+  e.swctl.fbJump = (jumpable ? SWL_JUMPABLE : 0);
+  e.swctl.bProgType = ptype;
+  e.hswitch = sw_entry;
+  return e;
+}
+
+SV *
+create_swentry( char *title, HWND owner_hwnd, HWND icon_hwnd, HPROGRAM owner_phandle,
+        PID owner_pid, ULONG owner_sid, ULONG visible, ULONG nonswitchable,
+        ULONG jumpable, ULONG ptype, HSWITCH sw_entry)
+{
+    SWENTRY e = swentry(title, owner_hwnd, icon_hwnd, owner_phandle, owner_pid,
+                       owner_sid, visible, nonswitchable, jumpable, ptype,
+                       sw_entry);
+
+    return newSVpvn((char*)&e, sizeof(e));
+}
+
+int
+change_swentrysw(SWENTRY *sw)
+{
+    ULONG rc;                  /* For CheckOSError */
+
+    if (!(_emx_env & 0x200)) 
+            croak("change_entry() not implemented on DOS"); /* not OS/2. */
+    if (!pWinChangeSwitchEntry)
+       AssignFuncPByORD(pWinChangeSwitchEntry, ORD_WinChangeSwitchEntry);
+    return !CheckOSError(pWinChangeSwitchEntry(sw->hswitch, &sw->swctl));
+}
+
+int
+change_swentry(SV *sv)
+{
+    STRLEN l;
+    PSWENTRY pswentry = (PSWENTRY)SvPV(sv, l);
+
+    if (l != sizeof(SWENTRY))
+       croak("Wrong structure size %ld!=%ld in change_swentry()", (long)l, (long)sizeof(SWENTRY));
+    return change_swentrysw(pswentry);
+}
+
+
+#define swentry_size()         (sizeof(SWENTRY))
+
+void
+getscrsize(int *wp, int *hp)
+{
+    int i[2];
+
+    _scrsize(i);
+    *wp = i[0];
+    *hp = i[1];
+}
+
+/* Force vio to not cross 64K-boundary: */
+#define VIO_FROM_VIOB                  \
+    vio = viob;                                \
+    if (!_THUNK_PTR_STRUCT_OK(vio))    \
+       vio++
+
+bool
+scrsize_set(int w, int h)
+{
+    VIOMODEINFO viob[2], *vio;
+    ULONG rc;
+
+    VIO_FROM_VIOB;
+
+    if (h == -9999)
+       h = w, w = 0;
+    vio->cb = sizeof(*vio);
+    if (CheckOSError(VioGetMode( vio, 0 )))
+       return 0;
+
+    if( w > 0 )
+      vio->col = (USHORT)w;
+
+    if( h > 0 )
+      vio->row = (USHORT)h;
+
+    vio->cb = 8;
+    if (CheckOSError(VioSetMode( vio, 0 )))
+       return 0;
+    return 1;
+}
+
+void
+cursor(int *sp, int *ep, int *wp, int *ap)
+{
+    VIOCURSORINFO viob[2], *vio;
+    ULONG rc;
+
+    VIO_FROM_VIOB;
+
+    if (CheckOSError(VioGetCurType( vio, 0 )))
+       croak("VioGetCurType() error");
+
+    *sp = vio->yStart;
+    *ep = vio->cEnd;
+    *wp = vio->cx;
+    *ep = vio->attr;
+}
+
+bool
+cursor__(int is_a)
+{
+    int s,e,w,a;
+
+    cursor(&s, &e, &w, &a);
+    if (is_a)
+       return a;
+    else
+       return w;
+}
+
+bool
+cursor_set(int s, int e, int w, int a)
+{
+    VIOCURSORINFO viob[2], *vio;
+    ULONG rc;
+
+    VIO_FROM_VIOB;
+
+    vio->yStart = s;
+    vio->cEnd = e;
+    vio->cx = w;
+    vio->attr = a;
+    return !CheckOSError(VioSetCurType( vio, 0 ));
+}
+
+static int
+bufsize(void)
+{
+#if 1
+    VIOMODEINFO viob[2], *vio;
+    ULONG rc;
+
+    VIO_FROM_VIOB;
+
+    vio->cb = sizeof(*vio);
+    if (CheckOSError(VioGetMode( vio, 0 )))
+       croak("Can't get size of buffer for screen");
+#if 0  /* buf=323552247, full=1118455, partial=0 */
+    croak("Lengths: buf=%d, full=%d, partial=%d",vio->buf_length,vio->full_length,vio->partial_length);
+    return newSVpvn((char*)vio->buf_addr, vio->full_length);
+#endif
+    return vio->col * vio->row * 2;    /* How to get bytes/cell?  2 or 4? */
+#else  /* 0 */
+    int i[2];
+
+    _scrsize(i);
+    return i[0]*i[1]*2;
+#endif /* 0 */
+}
+    
+SV *
+screen(void)
+{
+    ULONG rc;
+    USHORT bufl = bufsize();
+    char b[(1<<16) * 3]; /* This/3 is enough for 16-bit calls, we need
+                           2x overhead due to 2 vs 4 issue, and extra
+                           64K due to alignment logic */
+    char *buf = b;
+    
+    if (((ULONG)buf) & 0xFFFF)
+       buf += 0x10000 - (((ULONG)buf) & 0xFFFF);
+    if ((sizeof(b) - (buf - b)) < 2*bufl)
+       croak("panic: VIO buffer allocation");
+    if (CheckOSError(VioReadCellStr( buf, &bufl, 0, 0, 0 )))
+       return &PL_sv_undef;
+    return newSVpvn(buf,bufl);
+}
+
+bool
+screen_set(SV *sv)
+{
+    ULONG rc;
+    STRLEN l = SvCUR(sv), bufl = bufsize();
+    char b[(1<<16) * 2]; /* This/2 is enough for 16-bit calls, we need
+                           extra 64K due to alignment logic */
+    char *buf = b;
+    
+    if (((ULONG)buf) & 0xFFFF)
+       buf += 0x10000 - (((ULONG)buf) & 0xFFFF);
+    if (!SvPOK(sv) || ((l != bufl) && (l != 2*bufl)))
+       croak("Wrong size %d of saved screen data", SvCUR(sv));
+    if ((sizeof(b) - (buf - b)) < l)
+       croak("panic: VIO buffer allocation");
+    Copy(SvPV(sv,l), buf, bufl, char);
+    if (CheckOSError(VioWrtCellStr( buf, bufl, 0, 0, 0 )))
+       return 0;
+    return 1;
+}
+
+int
+process_codepages()
+{
+    ULONG cps[4], cp, rc;
+
+    if (CheckOSError(DosQueryCp( sizeof(cps), cps, &cp )))
+       croak("DosQueryCp() error");
+    return cp;
+}
+
+int
+out_codepage()
+{
+    USHORT cp, rc;
+
+    if (CheckOSError(VioGetCp( 0, &cp, 0 )))
+       croak("VioGetCp() error");
+    return cp;
+}
+
+bool
+out_codepage_set(int cp)
+{
+    USHORT rc;
+
+    return !(CheckOSError(VioSetCp( 0, cp, 0 )));
+}
+
+int
+in_codepage()
+{
+    USHORT cp, rc;
+
+    if (CheckOSError(KbdGetCp( 0, &cp, 0 )))
+       croak("KbdGetCp() error");
+    return cp;
+}
+
+bool
+in_codepage_set(int cp)
+{
+    USHORT rc;
+
+    return !(CheckOSError(KbdSetCp( 0, cp, 0 )));
+}
+
+bool
+process_codepage_set(int cp)
+{
+    USHORT rc;
+
+    return !(CheckOSError(DosSetProcessCp( cp )));
+}
+
+int
+ppidOf(int pid)
+{
+  PQTOPLEVEL psi;
+  int ppid;
+
+  if (!pid)
+      return -1;
+  psi = get_sysinfo(pid, QSS_PROCESS);
+  if (!psi)
+      return -1;
+  ppid = psi->procdata->ppid;
+  Safefree(psi);
+  return ppid;
+}
+
+int
+sidOf(int pid)
+{
+  PQTOPLEVEL psi;
+  int sid;
+
+  if (!pid)
+      return -1;
+  psi = get_sysinfo(pid, QSS_PROCESS);
+  if (!psi)
+      return -1;
+  sid = psi->procdata->sessid;
+  Safefree(psi);
+  return sid;
+}
+
 MODULE = OS2::Process          PACKAGE = OS2::Process
 
 
@@ -351,26 +914,179 @@ U32
 file_type(path)
     char *path
 
-U32
-process_entry()
+SV *
+swentry_expand( SV *sv )
     PPCODE:
      {
-        SWCNTRL swcntrl;
-
-        fill_swcntrl(&swcntrl);
-        EXTEND(sp,9);
-        PUSHs(sv_2mortal(newSVpv(swcntrl.szSwtitle, 0)));
-        PUSHs(sv_2mortal(newSVnv(swcntrl.hwnd)));
-        PUSHs(sv_2mortal(newSVnv(swcntrl.hwndIcon)));
-        PUSHs(sv_2mortal(newSViv(swcntrl.hprog)));
-        PUSHs(sv_2mortal(newSViv(swcntrl.idProcess)));
-        PUSHs(sv_2mortal(newSViv(swcntrl.idSession)));
-        PUSHs(sv_2mortal(newSViv(swcntrl.uchVisibility != SWL_INVISIBLE)));
-        PUSHs(sv_2mortal(newSViv(swcntrl.uchVisibility == SWL_GRAYED)));
-        PUSHs(sv_2mortal(newSViv(swcntrl.fbJump == SWL_JUMPABLE)));
-        PUSHs(sv_2mortal(newSViv(swcntrl.bProgType)));
+        STRLEN l;
+        PSWENTRY pswentry = (PSWENTRY)SvPV(sv, l);
+
+        if (l != sizeof(SWENTRY))
+               croak("Wrong structure size %ld!=%ld in swentry_expand()", (long)l, (long)sizeof(SWENTRY));
+        EXTEND(sp,11);
+        PUSHs(sv_2mortal(newSVpv(pswentry->swctl.szSwtitle, 0)));
+        PUSHs(sv_2mortal(newSVnv(pswentry->swctl.hwnd)));
+        PUSHs(sv_2mortal(newSVnv(pswentry->swctl.hwndIcon)));
+        PUSHs(sv_2mortal(newSViv(pswentry->swctl.hprog)));
+        PUSHs(sv_2mortal(newSViv(pswentry->swctl.idProcess)));
+        PUSHs(sv_2mortal(newSViv(pswentry->swctl.idSession)));
+        PUSHs(sv_2mortal(newSViv(pswentry->swctl.uchVisibility & SWL_VISIBLE)));
+        PUSHs(sv_2mortal(newSViv(pswentry->swctl.uchVisibility & SWL_GRAYED)));
+        PUSHs(sv_2mortal(newSViv(pswentry->swctl.fbJump == SWL_JUMPABLE)));
+        PUSHs(sv_2mortal(newSViv(pswentry->swctl.bProgType)));
+        PUSHs(sv_2mortal(newSViv(pswentry->hswitch)));
      }
 
+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)
+
+int
+change_swentry( SV *sv )
+
 bool
-set_title(s)
+sesmgr_title_set(s)
     char *s
+
+SV *
+process_swentry(unsigned long pid = getpid(), unsigned long hwnd = NULLHANDLE);
+
+int
+swentry_size()
+
+SV *
+swentries_list()
+
+int
+WindowText_set(unsigned long hwndFrame, char *title)
+
+bool
+FocusWindow_set(unsigned long hwndFocus, unsigned long hwndDesktop = HWND_DESKTOP)
+
+bool
+ShowWindow(unsigned long hwnd, bool fShow = TRUE)
+
+bool
+PostMsg(unsigned long hwnd, unsigned long msg, unsigned long mp1 = 0, unsigned long mp2 = 0)
+
+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)
+
+unsigned long
+BeginEnumWindows(unsigned long hwnd)
+
+bool
+EndEnumWindows(unsigned long henum)
+
+unsigned long
+GetNextWindow(unsigned long henum)
+
+bool
+IsWindow(unsigned long hwnd, unsigned long hab = Acquire_hab())
+
+unsigned long
+QueryWindow(unsigned long hwnd, long cmd)
+
+unsigned long
+IsChild(unsigned long hwnd, unsigned long hwndParent)
+
+unsigned long
+WindowFromId(unsigned long hwndParent, unsigned long id)
+
+unsigned long
+WindowFromPoint(long x, long y, unsigned long hwnd, bool fChildren = 0)
+
+unsigned long
+EnumDlgItem(unsigned long hwndDlg, unsigned long code, unsigned long hwnd = NULLHANDLE)
+   C_ARGS: hwndDlg, hwnd, code
+
+int
+out_codepage()
+
+bool
+out_codepage_set(int cp)
+
+int
+in_codepage()
+
+bool
+in_codepage_set(int cp)
+
+SV *
+screen()
+
+bool
+screen_set(SV *sv)
+
+SV *
+process_codepages()
+  PPCODE:
+  {
+    ULONG cps[4], c, i = 0, rc;
+
+    if (CheckOSError(DosQueryCp( sizeof(cps), cps, &c )))
+       c = 0;
+    c /= sizeof(ULONG);
+    if (c >= 3)
+    EXTEND(sp, c);
+    while (i < c)
+       PUSHs(sv_2mortal(newSViv(cps[i++])));
+  }
+
+bool
+process_codepage_set(int cp)
+
+MODULE = OS2::Process          PACKAGE = OS2::Process  PREFIX = Query
+
+unsigned long
+QueryFocusWindow(unsigned long hwndDesktop = HWND_DESKTOP)
+
+long
+QueryWindowTextLength(unsigned long hwnd)
+
+SV *
+QueryWindowText(unsigned long hwnd)
+
+SV *
+QueryWindowSWP(unsigned long hwnd)
+
+SV *
+QueryClassName(unsigned long hwnd)
+
+MODULE = OS2::Process          PACKAGE = OS2::Process  PREFIX = myWin
+
+NO_OUTPUT BOOL
+myWinQueryWindowProcess(unsigned long hwnd, OUTLIST unsigned long pid, OUTLIST unsigned long tid)
+   POSTCALL:
+       if (CheckWinError(RETVAL))
+           croak("QueryWindowProcess() error");
+
+void
+cursor(OUTLIST int stp, OUTLIST int ep, OUTLIST int wp, OUTLIST int ap)
+
+bool
+cursor_set(int s, int e, int w = cursor__(0), int a = cursor__(1))
+
+int
+myWinSwitchToProgram(unsigned long hsw)
+    PREINIT:
+       ULONG rc;
+
+unsigned long
+myWinQueryActiveWindow(unsigned long hwnd = HWND_DESKTOP)
+
+MODULE = OS2::Process          PACKAGE = OS2::Process  PREFIX = get
+
+int
+getppid()
+
+int
+ppidOf(int pid = getpid())
+
+int
+sidOf(int pid = getpid())
+
+void
+getscrsize(OUTLIST int wp, OUTLIST int hp)
+
+bool
+scrsize_set(int w_or_h, int h = -9999)
index f88d0af..85944c7 100644 (file)
@@ -25,9 +25,11 @@ static SHVBLOCK * vars;
 static int       nvars;
 static char *    trace;
 
+/*
 static RXSTRING   rxcommand    = {  9, "RXCOMMAND" };
 static RXSTRING   rxsubroutine = { 12, "RXSUBROUTINE" };
 static RXSTRING   rxfunction   = { 11, "RXFUNCTION" };
+*/
 
 static ULONG PERLCALL(PCSZ name, ULONG argc, PRXSTRING argv, PCSZ queue, PRXSTRING ret);
 
@@ -43,16 +45,17 @@ static ULONG PERLCALL(PCSZ name, ULONG argc, PRXSTRING argv, PCSZ queue, PRXSTRI
 
 static long incompartment;
 
+static LONG    APIENTRY (*pRexxStart) (LONG, PRXSTRING, PSZ, PRXSTRING, 
+                                   PSZ, LONG, PRXSYSEXIT, PSHORT, PRXSTRING);
+static APIRET  APIENTRY (*pRexxRegisterFunctionExe) (PSZ,
+                                                 RexxFunctionHandler *);
+static APIRET  APIENTRY (*pRexxDeregisterFunction) (PSZ);
+
+static ULONG (*pRexxVariablePool) (PSHVBLOCK pRequest);
+
 static SV*
 exec_in_REXX(pTHX_ char *cmd, char * handlerName, RexxFunctionHandler *handler)
 {
-    HMODULE hRexx, hRexxAPI;
-    BYTE    buf[200];
-    LONG    APIENTRY (*pRexxStart) (LONG, PRXSTRING, PSZ, PRXSTRING, 
-                                   PSZ, LONG, PRXSYSEXIT, PSHORT, PRXSTRING);
-    APIRET  APIENTRY (*pRexxRegisterFunctionExe) (PSZ,
-                                                 RexxFunctionHandler *);
-    APIRET  APIENTRY (*pRexxDeregisterFunction) (PSZ);
     RXSTRING args[1];
     RXSTRING inst[2];
     RXSTRING result;
@@ -64,16 +67,6 @@ exec_in_REXX(pTHX_ char *cmd, char * handlerName, RexxFunctionHandler *handler)
        Perl_die(aTHX_ "Attempt to reenter into REXX compartment");
     incompartment = 1;
 
-    if (DosLoadModule(buf, sizeof buf, "REXX", &hRexx)
-       || DosLoadModule(buf, sizeof buf, "REXXAPI", &hRexxAPI)
-       || DosQueryProcAddr(hRexx, 0, "RexxStart", (PFN *)&pRexxStart)
-       || DosQueryProcAddr(hRexxAPI, 0, "RexxRegisterFunctionExe", 
-                           (PFN *)&pRexxRegisterFunctionExe)
-       || DosQueryProcAddr(hRexxAPI, 0, "RexxDeregisterFunction",
-                           (PFN *)&pRexxDeregisterFunction)) {
-       Perl_die(aTHX_ "REXX not available\n");
-    }
-
     if (handlerName)
        pRexxRegisterFunctionExe(handlerName, handler);
 
@@ -86,8 +79,10 @@ exec_in_REXX(pTHX_ char *cmd, char * handlerName, RexxFunctionHandler *handler)
 
     incompartment = 0;
     pRexxDeregisterFunction("StartPerl");
+#if 0                                  /* Do we want to restore these? */
     DosFreeModule(hRexxAPI);
     DosFreeModule(hRexx);
+#endif
     if (!RXNULLSTRING(result)) {
        res = newSVpv(RXSTRPTR(result), RXSTRLEN(result));
        DosFreeMem(RXSTRPTR(result));
@@ -128,7 +123,6 @@ PERLCALL(PCSZ name, ULONG argc, PRXSTRING argv, PCSZ queue, PRXSTRING ret)
     int i, rc;
     unsigned long len;
     char *str;
-    char **arr;
     SV *res;
     dSP;
 
@@ -207,6 +201,12 @@ needvars(int n)
 static void
 initialize(void)
 {
+    *(PFN *)&pRexxStart = loadByOrdinal(ORD_RexxStart, 1);
+    *(PFN *)&pRexxRegisterFunctionExe
+       = loadByOrdinal(ORD_RexxRegisterFunctionExe, 1);
+    *(PFN *)&pRexxDeregisterFunction
+       = loadByOrdinal(ORD_RexxDeregisterFunction, 1);
+    *(PFN *)&pRexxVariablePool = loadByOrdinal(ORD_RexxVariablePool, 1);
     needstrs(8);
     needvars(8);
     trace = getenv("PERL_REXX_DEBUG");
@@ -262,15 +262,15 @@ _set(name,value,...)
           MAKERXSTRING(var->shvvalue, value, valuelen);
           if (trace)
               fprintf(stderr, " %.*s='%.*s'",
-                      var->shvname.strlength, var->shvname.strptr,
-                      var->shvvalue.strlength, var->shvvalue.strptr);
+                      (int)var->shvname.strlength, var->shvname.strptr,
+                      (int)var->shvvalue.strlength, var->shvvalue.strptr);
        }
        if (trace)
           fprintf(stderr, "\n");
        vars[n-1].shvnext = NULL;
-       rc = RexxVariablePool(vars);
+       rc = pRexxVariablePool(vars);
        if (trace)
-          fprintf(stderr, "  rc=%X\n", rc);
+          fprintf(stderr, "  rc=%#lX\n", rc);
        RETVAL = (rc & ~RXSHV_NEWV) ? FALSE : TRUE;
    }
  OUTPUT:
@@ -303,7 +303,7 @@ _fetch(name, ...)
        if (trace)
           fprintf(stderr, "\n");
        vars[items-1].shvnext = NULL;
-       rc = RexxVariablePool(vars);
+       rc = pRexxVariablePool(vars);
        if (!(rc & ~RXSHV_NEWV)) {
           for (i = 0; i < items; ++i) {
               int namelen;
@@ -315,7 +315,7 @@ _fetch(name, ...)
                   namelen = var->shvvaluelen; /* is */
               if (trace)
                   fprintf(stderr, "  %.*s='%.*s'\n",
-                          var->shvname.strlength, var->shvname.strptr,
+                          (int)var->shvname.strlength, var->shvname.strptr,
                           namelen, var->shvvalue.strptr);
               if (var->shvret & RXSHV_NEWV || !var->shvvalue.strptr)
                   PUSHs(&PL_sv_undef);
@@ -325,7 +325,7 @@ _fetch(name, ...)
           }
        } else {
           if (trace)
-              fprintf(stderr, "  rc=%X\n", rc);
+              fprintf(stderr, "  rc=%#lX\n", rc);
        }
    }
 
@@ -351,7 +351,7 @@ _next(stem)
               DosFreeMem(sv.shvvalue.strptr);
               MAKERXSTRING(sv.shvvalue, NULL, 0);
           }
-          rc = RexxVariablePool(&sv);
+          rc = pRexxVariablePool(&sv);
        } while (!rc && memcmp(stem, sv.shvname.strptr, len) != 0);
        if (!rc) {
           EXTEND(SP, 2);
@@ -377,7 +377,7 @@ _next(stem)
           die("Error %i when in _next", rc);
        } else {
           if (trace)
-              fprintf(stderr, "  rc=%X\n", rc);
+              fprintf(stderr, "  rc=%#lX\n", rc);
        }
    }
 
@@ -400,7 +400,7 @@ _drop(name,...)
           MAKERXSTRING(var->shvvalue, NULL, 0);
        }
        vars[items-1].shvnext = NULL;
-       RETVAL = (RexxVariablePool(vars) & ~RXSHV_NEWV) ? FALSE : TRUE;
+       RETVAL = (pRexxVariablePool(vars) & ~RXSHV_NEWV) ? FALSE : TRUE;
    }
  OUTPUT:
     RETVAL
@@ -409,7 +409,7 @@ int
 _register(name)
        char *  name
  CODE:
-    RETVAL = RexxRegisterFunctionExe(name, PERLCALL);
+    RETVAL = pRexxRegisterFunctionExe(name, PERLCALL);
  OUTPUT:
     RETVAL
 
index aaeeb58..5c8b6e6 100644 (file)
@@ -11,18 +11,21 @@ static char fail[300];
 char *os2error(int rc);
 
 void *
-dlopen(char *path, int mode)
+dlopen(const char *path, int mode)
 {
        HMODULE handle;
        char tmp[260], *beg, *dot;
        ULONG rc;
 
        fail[0] = 0;
-       if ((rc = DosLoadModule(fail, sizeof fail, path, &handle)) == 0)
+       if ((rc = DosLoadModule(fail, sizeof fail, (char*)path, &handle)) == 0)
                return (void *)handle;
 
        retcode = rc;
 
+       if (strlen(path) >= sizeof(tmp))
+           return NULL;
+
        /* Not found. Check for non-FAT name and try truncated name. */
        /* Don't know if this helps though... */
        for (beg = dot = path + strlen(path);
@@ -32,6 +35,7 @@ dlopen(char *path, int mode)
                        dot = beg;
        if (dot - beg > 8) {
                int n = beg+8-path;
+
                memmove(tmp, path, n);
                memmove(tmp+n, dot, strlen(dot)+1);
                if (DosLoadModule(fail, sizeof fail, tmp, &handle) == 0)
@@ -42,7 +46,7 @@ dlopen(char *path, int mode)
 }
 
 void *
-dlsym(void *handle, char *symbol)
+dlsym(void *handle, const char *symbol)
 {
        ULONG rc, type;
        PFN addr;
index c2feee6..80e5aac 100644 (file)
@@ -1,4 +1,4 @@
-void *dlopen(char *path, int mode);
-void *dlsym(void *handle, char *symbol);
+void *dlopen(const char *path, int mode);
+void *dlsym(void *handle, const char *symbol);
 char *dlerror(void);
 int dlclose(void *handle);
index 67fe3b7..03c06ed 100644 (file)
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -186,83 +186,199 @@ os2_cond_wait(perl_cond *c, perl_mutex *m)
 
 /*****************************************************************************/
 /* 2.1 would not resolve symbols on demand, and has no ExtLIBPATH. */
-static PFN ExtFCN[2];                  /* Labeled by ord below. */
-static USHORT loadOrd[2] = { 874, 873 }; /* Query=874, Set=873. */
-#define ORD_QUERY_ELP  0
-#define ORD_SET_ELP    1
+#define C_ARR_LEN(sym) (sizeof(sym)/sizeof(*sym))
+
+struct dll_handle {
+    const char *modname;
+    HMODULE handle;
+};
+static struct dll_handle doscalls_handle = {"doscalls", 0};
+static struct dll_handle tcp_handle = {"tcp32dll", 0};
+static struct dll_handle pmwin_handle = {"pmwin", 0};
+static struct dll_handle rexx_handle = {"rexx", 0};
+static struct dll_handle rexxapi_handle = {"rexxapi", 0};
+static struct dll_handle sesmgr_handle = {"sesmgr", 0};
+static struct dll_handle pmshapi_handle = {"pmshapi", 0};
+
+/* This should match enum entries_ordinals defined in os2ish.h. */
+static const struct {
+    struct dll_handle *dll;
+    const char *entryname;
+    int entrypoint;
+} loadOrdinals[ORD_NENTRIES] = { 
+  {&doscalls_handle, NULL, 874},       /* DosQueryExtLibpath */
+  {&doscalls_handle, NULL, 873},       /* DosSetExtLibpath */
+  {&doscalls_handle, NULL, 460},       /* DosVerifyPidTid */
+  {&tcp_handle, "SETHOSTENT", 0},
+  {&tcp_handle, "SETNETENT" , 0},
+  {&tcp_handle, "SETPROTOENT", 0},
+  {&tcp_handle, "SETSERVENT", 0},
+  {&tcp_handle, "GETHOSTENT", 0},
+  {&tcp_handle, "GETNETENT" , 0},
+  {&tcp_handle, "GETPROTOENT", 0},
+  {&tcp_handle, "GETSERVENT", 0},
+  {&tcp_handle, "ENDHOSTENT", 0},
+  {&tcp_handle, "ENDNETENT", 0},
+  {&tcp_handle, "ENDPROTOENT", 0},
+  {&tcp_handle, "ENDSERVENT", 0},
+  {&pmwin_handle, NULL, 763},          /* WinInitialize */
+  {&pmwin_handle, NULL, 716},          /* WinCreateMsgQueue */
+  {&pmwin_handle, NULL, 726},          /* WinDestroyMsgQueue */
+  {&pmwin_handle, NULL, 918},          /* WinPeekMsg */
+  {&pmwin_handle, NULL, 915},          /* WinGetMsg */
+  {&pmwin_handle, NULL, 912},          /* WinDispatchMsg */
+  {&pmwin_handle, NULL, 753},          /* WinGetLastError */
+  {&pmwin_handle, NULL, 705},          /* WinCancelShutdown */
+       /* These are needed in extensions.
+          How to protect PMSHAPI: it comes through EMX functions? */
+  {&rexx_handle,    "RexxStart", 0},
+  {&rexx_handle,    "RexxVariablePool", 0},
+  {&rexxapi_handle, "RexxRegisterFunctionExe", 0},
+  {&rexxapi_handle, "RexxDeregisterFunction", 0},
+  {&sesmgr_handle,  "DOSSMSETTITLE", 0}, /* Would not work runtime-loaded */
+  {&pmshapi_handle, "PRF32QUERYPROFILESIZE", 0},
+  {&pmshapi_handle, "PRF32OPENPROFILE", 0},
+  {&pmshapi_handle, "PRF32CLOSEPROFILE", 0},
+  {&pmshapi_handle, "PRF32QUERYPROFILE", 0},
+  {&pmshapi_handle, "PRF32RESET", 0},
+  {&pmshapi_handle, "PRF32QUERYPROFILEDATA", 0},
+  {&pmshapi_handle, "PRF32WRITEPROFILEDATA", 0},
+
+  /* At least some of these do not work by name, since they need
+       WIN32 instead of WIN... */
+#if 0
+  These were generated with
+    nm I:\emx\lib\os2.a  | fgrep -f API-list | grep = > API-list-entries
+    perl -wnle "next unless /^0+\s+E\s+_(\w+)=(\w+).(\d+)/; print qq(    ORD_$1,)" API-list-entries > API-list-ORD_
+    perl -wnle "next unless /^0+\s+E\s+_(\w+)=(\w+).(\d+)/; print qq(  {${2}_handle, NULL, $3},\t\t/* $1 */)" WinSwitch-API-list-entries  >API-list-entry
+#endif
+  {&pmshapi_handle, NULL, 123},                /* WinChangeSwitchEntry */
+  {&pmshapi_handle, NULL, 124},                /* WinQuerySwitchEntry */
+  {&pmshapi_handle, NULL, 125},                /* WinQuerySwitchHandle */
+  {&pmshapi_handle, NULL, 126},                /* WinQuerySwitchList */
+  {&pmshapi_handle, NULL, 131},                /* WinSwitchToProgram */
+  {&pmwin_handle, NULL, 702},          /* WinBeginEnumWindows */
+  {&pmwin_handle, NULL, 737},          /* WinEndEnumWindows */
+  {&pmwin_handle, NULL, 740},          /* WinEnumDlgItem */
+  {&pmwin_handle, NULL, 756},          /* WinGetNextWindow */
+  {&pmwin_handle, NULL, 768},          /* WinIsChild */
+  {&pmwin_handle, NULL, 799},          /* WinQueryActiveWindow */
+  {&pmwin_handle, NULL, 805},          /* WinQueryClassName */
+  {&pmwin_handle, NULL, 817},          /* WinQueryFocus */
+  {&pmwin_handle, NULL, 834},          /* WinQueryWindow */
+  {&pmwin_handle, NULL, 837},          /* WinQueryWindowPos */
+  {&pmwin_handle, NULL, 838},          /* WinQueryWindowProcess */
+  {&pmwin_handle, NULL, 841},          /* WinQueryWindowText */
+  {&pmwin_handle, NULL, 842},          /* WinQueryWindowTextLength */
+  {&pmwin_handle, NULL, 860},          /* WinSetFocus */
+  {&pmwin_handle, NULL, 875},          /* WinSetWindowPos */
+  {&pmwin_handle, NULL, 877},          /* WinSetWindowText */
+  {&pmwin_handle, NULL, 883},          /* WinShowWindow */
+  {&pmwin_handle, NULL, 872},          /* WinIsWindow */
+  {&pmwin_handle, NULL, 899},          /* WinWindowFromId */
+  {&pmwin_handle, NULL, 900},          /* WinWindowFromPoint */
+  {&pmwin_handle, NULL, 919},          /* WinPostMsg */
+};
+
+static PFN ExtFCN[C_ARR_LEN(loadOrdinals)];    /* Labeled by ord ORD_*. */
+const Perl_PFN * const pExtFCN = ExtFCN;
 struct PMWIN_entries_t PMWIN_entries;
 
 HMODULE
-loadModule(char *modname)
+loadModule(const char *modname, int fail)
 {
     HMODULE h = (HMODULE)dlopen(modname, 0);
-    if (!h)
+
+    if (!h && fail)
        Perl_croak_nocontext("Error loading module '%s': %s", 
                             modname, dlerror());
     return h;
 }
 
-void
-loadByOrd(char *modname, ULONG ord)
+PFN
+loadByOrdinal(enum entries_ordinals ord, int fail)
 {
     if (ExtFCN[ord] == NULL) {
-       static HMODULE hdosc = 0;
        PFN fcn = (PFN)-1;
        APIRET rc;
 
-       if (!hdosc)
-           hdosc = loadModule(modname);
-       if (CheckOSError(DosQueryProcAddr(hdosc, loadOrd[ord], NULL, &fcn)))
+       if (!loadOrdinals[ord].dll->handle)
+           loadOrdinals[ord].dll->handle
+               = loadModule(loadOrdinals[ord].dll->modname, fail);
+       if (!loadOrdinals[ord].dll->handle)
+           return 0;                   /* Possible with FAIL==0 only */
+       if (CheckOSError(DosQueryProcAddr(loadOrdinals[ord].dll->handle,
+                                         loadOrdinals[ord].entrypoint,
+                                         loadOrdinals[ord].entryname,&fcn))) {
+           char buf[20], *s = (char*)loadOrdinals[ord].entryname;
+
+           if (!fail)
+               return 0;
+           if (!s)
+               sprintf(s = buf, "%d", loadOrdinals[ord].entrypoint);
            Perl_croak_nocontext(
-                       "This version of OS/2 does not support %s.%i", 
-                       modname, loadOrd[ord]);     
+                "This version of OS/2 does not support %s.%s", 
+                loadOrdinals[ord].dll->modname, s);
+       }
        ExtFCN[ord] = fcn;
     } 
-    if ((long)ExtFCN[ord] == -1) 
+    if ((long)ExtFCN[ord] == -1)
        Perl_croak_nocontext("panic queryaddr");
+    return ExtFCN[ord];
 }
 
 void 
 init_PMWIN_entries(void)
 {
-    static HMODULE hpmwin = 0;
-    static const int ords[] = {
-       763,                            /* Initialize */
-       716,                            /* CreateMsgQueue */
-       726,                            /* DestroyMsgQueue */
-       918,                            /* PeekMsg */
-       915,                            /* GetMsg */
-       912,                            /* DispatchMsg */
-       753,                            /* GetLastError */
-       705,                            /* CancelShutdown */
-    };
-    int i = 0;
-    unsigned long rc;
-
-    if (hpmwin)
-       return;
-
-    hpmwin = loadModule("pmwin");
-    while (i < sizeof(ords)/sizeof(int)) {
-       if (CheckOSError(DosQueryProcAddr(hpmwin, ords[i], NULL, 
-                                         ((PFN*)&PMWIN_entries)+i)))
-           Perl_croak_nocontext("This version of OS/2 does not support pmwin.%d", ords[i]);
-       i++;
-    }
+    int i;
+
+    for (i = ORD_WinInitialize; i <= ORD_WinCancelShutdown; i++)
+       ((PFN*)&PMWIN_entries)[i - ORD_WinInitialize] = loadByOrdinal(i, 1);
 }
 
+/*****************************************************/
+/* socket forwarders without linking with tcpip DLLs */
+
+DeclFuncByORD(struct hostent *,  gethostent,  ORD_GETHOSTENT,  (void), ())
+DeclFuncByORD(struct netent  *,  getnetent,   ORD_GETNETENT,   (void), ())
+DeclFuncByORD(struct protoent *, getprotoent, ORD_GETPROTOENT, (void), ())
+DeclFuncByORD(struct servent *,  getservent,  ORD_GETSERVENT,  (void), ())
+
+DeclVoidFuncByORD(sethostent,  ORD_SETHOSTENT,  (int x), (x))
+DeclVoidFuncByORD(setnetent,   ORD_SETNETENT,   (int x), (x))
+DeclVoidFuncByORD(setprotoent, ORD_SETPROTOENT, (int x), (x))
+DeclVoidFuncByORD(setservent,  ORD_SETSERVENT,  (int x), (x))
+
+DeclVoidFuncByORD(endhostent,  ORD_ENDHOSTENT,  (void), ())
+DeclVoidFuncByORD(endnetent,   ORD_ENDNETENT,   (void), ())
+DeclVoidFuncByORD(endprotoent, ORD_ENDPROTOENT, (void), ())
+DeclVoidFuncByORD(endservent,  ORD_ENDSERVENT,  (void), ())
 
 /* priorities */
 static signed char priors[] = {0, 1, 3, 2}; /* Last two interchanged,
                                               self inverse. */
 #define QSS_INI_BUFFER 1024
 
+ULONG (*pDosVerifyPidTid) (PID pid, TID tid);
+static int pidtid_lookup;
+
 PQTOPLEVEL
 get_sysinfo(ULONG pid, ULONG flags)
 {
     char *pbuffer;
     ULONG rc, buf_len = QSS_INI_BUFFER;
+    PQTOPLEVEL psi;
 
+    if (!pidtid_lookup) {
+       pidtid_lookup = 1;
+       *(PFN*)&pDosVerifyPidTid = loadByOrdinal(ORD_DosVerifyPidTid, 0);
+    }
+    if (pDosVerifyPidTid) {    /* Warp3 or later */
+       /* Up to some fixpak QuerySysState() kills the system if a non-existent
+          pid is used. */
+       if (!pDosVerifyPidTid(pid, 1))
+           return 0;
+    }
     New(1322, pbuffer, buf_len, char);
     /* QSS_PROCESS | QSS_MODULE | QSS_SEMAPHORES | QSS_SHARED */
     rc = QuerySysState(flags, pid, pbuffer, buf_len);
@@ -275,7 +391,12 @@ get_sysinfo(ULONG pid, ULONG flags)
        Safefree(pbuffer);
        return 0;
     }
-    return (PQTOPLEVEL)pbuffer;
+    psi = (PQTOPLEVEL)pbuffer;
+    if (psi && pid && pid != psi->procdata->pid) {
+      Safefree(psi);
+      Perl_croak_nocontext("panic: wrong pid in sysinfo");
+    }
+    return psi;
 }
 
 #define PRIO_ERR 0x1111
@@ -286,14 +407,11 @@ sys_prio(pid)
   ULONG prio;
   PQTOPLEVEL psi;
 
+  if (!pid)
+      return PRIO_ERR;
   psi = get_sysinfo(pid, QSS_PROCESS);
-  if (!psi) {
+  if (!psi)
       return PRIO_ERR;
-  }
-  if (pid != psi->procdata->pid) {
-      Safefree(psi);
-      Perl_croak_nocontext("panic: wrong pid in sysinfo");
-  }
   prio = psi->procdata->threads->priority;
   Safefree(psi);
   return prio;
@@ -331,12 +449,6 @@ setpriority(int which, int pid, int val)
                                         abs(pid)))
          ? -1 : 0;
   } 
-/*   else return CheckOSError(DosSetPriority((pid < 0)  */
-/*                                       ? PRTYS_PROCESSTREE : PRTYS_PROCESS, */
-/*                                       priors[(32 - val) >> 5] + 1,  */
-/*                                       (32 - val) % 32 - (prio & 0xFF),  */
-/*                                       abs(pid))) */
-/*       ? -1 : 0; */
 }
 
 int 
@@ -1122,51 +1234,6 @@ char *   ctermid(char *s)        { return 0; }
 void * ttyname(x)      { return 0; }
 #endif
 
-/******************************************************************/
-/* my socket forwarders - EMX lib only provides static forwarders */
-
-static HMODULE htcp = 0;
-
-static void *
-tcp0(char *name)
-{
-    PFN fcn;
-
-    if (!(_emx_env & 0x200)) Perl_croak_nocontext("%s requires OS/2", name); /* Die if not OS/2. */
-    if (!htcp)
-       htcp = loadModule("tcp32dll");
-    if (htcp && DosQueryProcAddr(htcp, 0, name, &fcn) == 0)
-       return (void *) ((void * (*)(void)) fcn) ();
-    return 0;
-}
-
-static void
-tcp1(char *name, int arg)
-{
-    static BYTE buf[20];
-    PFN fcn;
-
-    if (!(_emx_env & 0x200)) Perl_croak_nocontext("%s requires OS/2", name); /* Die if not OS/2. */
-    if (!htcp)
-       DosLoadModule(buf, sizeof buf, "tcp32dll", &htcp);
-    if (htcp && DosQueryProcAddr(htcp, 0, name, &fcn) == 0)
-       ((void (*)(int)) fcn) (arg);
-}
-
-struct hostent *       gethostent()    { return tcp0("GETHOSTENT");  }
-struct netent *                getnetent()     { return tcp0("GETNETENT");   }
-struct protoent *      getprotoent()   { return tcp0("GETPROTOENT"); }
-struct servent *       getservent()    { return tcp0("GETSERVENT");  }
-
-void   sethostent(x)   { tcp1("SETHOSTENT",  x); }
-void   setnetent(x)    { tcp1("SETNETENT",   x); }
-void   setprotoent(x)  { tcp1("SETPROTOENT", x); }
-void   setservent(x)   { tcp1("SETSERVENT",  x); }
-void   endhostent()    { tcp0("ENDHOSTENT");  }
-void   endnetent()     { tcp0("ENDNETENT");   }
-void   endprotoent()   { tcp0("ENDPROTOENT"); }
-void   endservent()    { tcp0("ENDSERVENT");  }
-
 /*****************************************************************************/
 /* not implemented in C Set++ */
 
@@ -2012,22 +2079,22 @@ APIRET
 ExtLIBPATH(ULONG ord, PSZ path, IV type)
 {
     ULONG what;
+    PFN f = loadByOrdinal(ord, 1);     /* Guarantied to load or die! */
 
-    loadByOrd("doscalls",ord);         /* Guarantied to load or die! */
     if (type > 0)
        what = END_LIBPATH;
     else if (type == 0)
        what = BEGIN_LIBPATH;
     else
        what = LIBPATHSTRICT;
-    return (*(PELP)ExtFCN[ord])(path, what);
+    return (*(PELP)f)(path, what);
 }
 
 #define extLibpath(to,type)                                            \
-    (CheckOSError(ExtLIBPATH(ORD_QUERY_ELP, (to), (type))) ? NULL : (to) )
+    (CheckOSError(ExtLIBPATH(ORD_DosQueryExtLibpath, (to), (type))) ? NULL : (to) )
 
 #define extLibpath_set(p,type)                                         \
-    (!CheckOSError(ExtLIBPATH(ORD_SET_ELP, (p), (type))))
+    (!CheckOSError(ExtLIBPATH(ORD_DosSetExtLibpath, (p), (type))))
 
 XS(XS_Cwd_extLibpath)
 {
diff --git a/os2/os2_base.t b/os2/os2_base.t
new file mode 100644 (file)
index 0000000..ceaeb3f
--- /dev/null
@@ -0,0 +1,49 @@
+print "1.." . lasttest() . "\n";
+
+$cwd = Cwd::sys_cwd();
+print "ok 1\n";
+print "not " unless -d $cwd;
+print "ok 2\n";
+
+$lpb = Cwd::extLibpath;
+print "ok 3\n";
+$lpb .= ';' unless $lpb and $lpb =~ /;$/;
+
+$lpe = Cwd::extLibpath(1);
+print "ok 4\n";
+$lpe .= ';' unless $lpe and $lpe =~ /;$/;
+
+Cwd::extLibpath_set("$lpb$cwd") or print "not ";
+print "ok 5\n";
+
+$lpb = Cwd::extLibpath;
+print "ok 6\n";
+$lpb =~ s#\\#/#g;
+($s_cwd = $cwd) =~ s#\\#/#g;
+
+print "not " unless $lpb =~ /\Q$s_cwd/;
+print "ok 7\n";
+
+Cwd::extLibpath_set("$lpe$cwd", 1) or print "not ";
+print "ok 8\n";
+
+$lpe = Cwd::extLibpath(1);
+print "ok 9\n";
+$lpe =~ s#\\#/#g;
+
+print "not " unless $lpe =~ /\Q$s_cwd/;
+print "ok 10\n";
+
+unshift @INC, 'lib';
+require OS2::Process;
+@l = OS2::Process::process_entry();
+print "not " unless @l == 11;
+print "ok 11\n";
+
+# 1: FS 2: Window-VIO 
+print "not " unless $l[9] == 1 or $l[9] == 2;
+print "ok 12\n";
+
+print "# $_\n" for @l;
+
+sub lasttest {12}
index e6cbe10..7f3393b 100644 (file)
@@ -469,9 +469,94 @@ void init_PMWIN_entries(void);
 
 #define STATIC_FILE_LENGTH 127
 
+    /* This should match loadOrdinals[] array in os2.c */
+enum entries_ordinals {
+    ORD_DosQueryExtLibpath,
+    ORD_DosSetExtLibpath,
+    ORD_DosVerifyPidTid,
+    ORD_SETHOSTENT,
+    ORD_SETNETENT, 
+    ORD_SETPROTOENT,
+    ORD_SETSERVENT,
+    ORD_GETHOSTENT,
+    ORD_GETNETENT, 
+    ORD_GETPROTOENT,
+    ORD_GETSERVENT,
+    ORD_ENDHOSTENT,
+    ORD_ENDNETENT,
+    ORD_ENDPROTOENT,
+    ORD_ENDSERVENT,
+    ORD_WinInitialize,
+    ORD_WinCreateMsgQueue,
+    ORD_WinDestroyMsgQueue,
+    ORD_WinPeekMsg,
+    ORD_WinGetMsg,
+    ORD_WinDispatchMsg,
+    ORD_WinGetLastError,
+    ORD_WinCancelShutdown,
+    ORD_RexxStart,
+    ORD_RexxVariablePool,
+    ORD_RexxRegisterFunctionExe,
+    ORD_RexxDeregisterFunction,
+    ORD_DOSSMSETTITLE,
+    ORD_PRF32QUERYPROFILESIZE,
+    ORD_PRF32OPENPROFILE,
+    ORD_PRF32CLOSEPROFILE,
+    ORD_PRF32QUERYPROFILE,
+    ORD_PRF32RESET,
+    ORD_PRF32QUERYPROFILEDATA,
+    ORD_PRF32WRITEPROFILEDATA,
+
+    ORD_WinChangeSwitchEntry,
+    ORD_WinQuerySwitchEntry,
+    ORD_WinQuerySwitchHandle,
+    ORD_WinQuerySwitchList,
+    ORD_WinSwitchToProgram,
+    ORD_WinBeginEnumWindows,
+    ORD_WinEndEnumWindows,
+    ORD_WinEnumDlgItem,
+    ORD_WinGetNextWindow,
+    ORD_WinIsChild,
+    ORD_WinQueryActiveWindow,
+    ORD_WinQueryClassName,
+    ORD_WinQueryFocus,
+    ORD_WinQueryWindow,
+    ORD_WinQueryWindowPos,
+    ORD_WinQueryWindowProcess,
+    ORD_WinQueryWindowText,
+    ORD_WinQueryWindowTextLength,
+    ORD_WinSetFocus,
+    ORD_WinSetWindowPos,
+    ORD_WinSetWindowText,
+    ORD_WinShowWindow,
+    ORD_WinIsWindow,
+    ORD_WinWindowFromId,
+    ORD_WinWindowFromPoint,
+    ORD_WinPostMsg,
+    ORD_NENTRIES
+};
+
+/* RET: return type, AT: argument signature in (), ARGS: should be in () */
+#define CallORD(ret,o,at,args) (((ret (*)at) loadByOrdinal(o, 1))args)
+#define DeclFuncByORD(ret,name,o,at,args)      \
+  ret name at { return CallORD(ret,o,at,args); }
+#define DeclVoidFuncByORD(name,o,at,args)      \
+  void name at { CallORD(void,o,at,args); }
+
+/* These functions return false on error, and save the error info in $^E */
+#define DeclOSFuncByORD(ret,name,o,at,args)    \
+  ret name at { unsigned long rc; return !CheckOSError(CallORD(ret,o,at,args)); }
+#define DeclWinFuncByORD(ret,name,o,at,args)   \
+  ret name at { return SaveWinError(CallORD(ret,o,at,args)); }
+
+#define AssignFuncPByORD(p,o)  (*(Perl_PFN*)&(p) = (loadByOrdinal(o, 1)))
+
 #define PERLLIB_MANGLE(s, n) perllib_mangle((s), (n))
 char *perllib_mangle(char *, unsigned int);
 
+typedef int (*Perl_PFN)();
+Perl_PFN loadByOrdinal(enum entries_ordinals ord, int fail);
+extern const Perl_PFN * const pExtFCN;
 char *os2error(int rc);
 int os2_stat(const char *name, struct stat *st);
 int setpriority(int which, int pid, int val);