Front page | perl.perl5.porters |
Postings from June 2001
[PATCH 5.6.1] OS/2 improvements
Thread Next
From:
Ilya Zakharevich
Date:
June 28, 2001 13:03
Subject:
[PATCH 5.6.1] OS/2 improvements
Message ID:
20010628160314.A17906@math.ohio-state.edu
The bulk of this are changes to OS::Process module. Annotation:
MANIFEST
os2/os2_base.t
hints/os2.sh New test file added
makedef.pl Two new symbols exported for the new framework
os2/dlfcn.h
os2/dl_os2.c Correct warnings
os2/os2.c
os2/os2ish.h New framework for runtime linking (see below);
Avoid kernel panic on getpriority() with a
wrong PID (on old versions of OS/2).
Unfortunately, the API we use in the
workaround is not present on *very old*
versions of OS/2... Tough luck...
os2/OS2/REXX/REXX.xs Warnings + use new framework
os2/OS2/Process/Process.xs
os2/OS2/Process/Process.pm Warnings + use new framework + docs
New APIs for information about text windows,
windows hierarchy
os2/OS2/PrfDB/PrfDB.xs Warnings + use new framework
=======================================================================
Runtime linking:
~~~~~~~~~~~~~~~
The idea of OS/2 port is to have a *portable* executable: an executable
which would work on any OS/2 system (with proper environment tweaking).
Let me recall that two executables are build (mostly by historic reasons),
one with a perl DLL, another statically linked - both Perl core and extensions.
While not strictly necessary nowadays, having a static link has an enormous
advantage, since one can carry it around easily (at least if one does not
need modules). Such an ability comes quite handy with a floppy-boot situation.
However, while Perl itself links with "simple" DLLs only, the modules
distributed with Perl require more advanced DLLs which are not present
during a floppy boot, since even loading them requires a Windowing System
(Presentation Manager) running. Thus one needs either abandon some
functionality, or have the executable unusable from a floppy boot.
On the third hand, perl core already uses some APIs which are present on newer
versions of OS/2 only, resolving them at runtime (so that some of
functionality is not present on older OSes, but the rest works). This
patch streamlines this framework, and makes it usable from extensions too.
This makes it possible to use the same executable for advanced work, as well
as from a floppy boot (for not-so-hairy targets).
Enjoy,
Ilya
--- ./MANIFEST.orig Mon Jun 25 15:09:40 2001
+++ ./MANIFEST Mon Jun 25 15:09:50 2001
@@ -1523,6 +1523,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
--- ./os2/os2_base.t.orig Mon Jun 25 02:58:12 2001
+++ ./os2/os2_base.t Tue Jun 26 00:59:42 2001
@@ -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}
--- ./hints/os2.sh.orig Tue Jun 26 11:15:40 2001
+++ ./hints/os2.sh Wed Jun 27 23:30:20 2001
@@ -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
--- ./makedef.pl.orig Sun Jun 24 05:59:46 2001
+++ ./makedef.pl Wed Jun 27 23:36:58 2001
@@ -340,6 +340,8 @@ elsif ($PLATFORM eq 'os2') {
init_PMWIN_entries
PMWIN_entries
Perl_hab_GET
+ loadByOrdinal
+ pExtFCN
)]);
}
elsif ($PLATFORM eq 'MacOS') {
--- ./os2/dlfcn.h.orig Sat Jun 2 09:11:00 2001
+++ ./os2/dlfcn.h Mon Jun 25 02:58:12 2001
@@ -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);
--- ./os2/dl_os2.c.orig Mon Jun 25 02:14:04 2001
+++ ./os2/dl_os2.c Mon Jun 25 02:58:12 2001
@@ -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;
--- ./os2/os2.c.orig Mon Jun 25 02:16:56 2001
+++ ./os2/os2.c Wed Jun 27 23:36:12 2001
@@ -186,83 +186,199 @@ os2_cond_wait(perl_cond *c, perl_mutex *
/*****************************************************************************/
/* 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)
{
--- ./os2/os2ish.h.orig Mon Jun 25 02:30:40 2001
+++ ./os2/os2ish.h Wed Jun 27 23:37:32 2001
@@ -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);
--- ./os2/OS2/REXX/REXX.xs.orig Mon Jun 25 01:33:42 2001
+++ ./os2/OS2/REXX/REXX.xs Mon Jun 25 02:58:14 2001
@@ -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 a
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 * han
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 * han
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, PRXSTRIN
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
--- ./os2/OS2/Process/Process.xs.orig Mon Jun 25 01:33:42 2001
+++ ./os2/OS2/Process/Process.xs Thu Jun 28 02:15:34 2001
@@ -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)(ULO
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;
+ STRLEN l;
+ PSWENTRY pswentry = (PSWENTRY)SvPV(sv, l);
- 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)));
+ 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)
--- ./os2/OS2/Process/Process.pm.orig Mon Jun 25 01:33:42 2001
+++ ./os2/OS2/Process/Process.pm Thu Jun 28 01:52:10 2001
@@ -1,12 +1,20 @@
-package OS2::Process;
+package OS2::localMorphPM;
+
+sub new { my ($c,$f) = @_; OS2::MorphPM($f); bless [shift], $c }
+sub DESTROY { OS2::UnMorphPM(shift->[0]) }
-$VERSION = 0.2;
+package OS2::Process;
-require Exporter;
-require DynaLoader;
-#require AutoLoader;
+BEGIN {
+ 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
=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 resu
=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,
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
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).
-- does not work with some windows (if the title is set from the start).
+=item process_entries()
+
+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 C<EndEnumWindows($eh)>
-=item get_title()
+End enumeration and release the list.
-is a shortcut implemented via process_entry().
+=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
--- ./os2/OS2/PrfDB/PrfDB.xs.orig Mon Jun 25 01:33:42 2001
+++ ./os2/OS2/PrfDB/PrfDB.xs Mon Jun 25 03:30:42 2001
@@ -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 ke
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);
+
Thread Next
-
[PATCH 5.6.1] OS/2 improvements
by Ilya Zakharevich