diff options
author | Ilya Zakharevich <ilya@math.berkeley.edu> | 2001-06-28 12:03:14 -0400 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2001-06-28 19:10:54 +0000 |
commit | 35bc1fdc44cabda9b94bf3b2cbffe0be67fef25d (patch) | |
tree | ce362683cbc25c281c69b49928a386e14df2dd92 /os2/OS2 | |
parent | 531b886104fed3302a6d671985aba5e2f6420dd5 (diff) | |
download | perl-35bc1fdc44cabda9b94bf3b2cbffe0be67fef25d.tar.gz |
OS/2 improvements
Message-ID: <20010628160314.A17906@math.ohio-state.edu>
p4raw-id: //depot/perl@11010
Diffstat (limited to 'os2/OS2')
-rw-r--r-- | os2/OS2/PrfDB/PrfDB.xs | 48 | ||||
-rw-r--r-- | os2/OS2/Process/Process.pm | 660 | ||||
-rw-r--r-- | os2/OS2/Process/Process.xs | 794 | ||||
-rw-r--r-- | os2/OS2/REXX/REXX.xs | 58 |
4 files changed, 1437 insertions, 123 deletions
diff --git a/os2/OS2/PrfDB/PrfDB.xs b/os2/OS2/PrfDB/PrfDB.xs index e747fcf377..bc4661a5d6 100644 --- a/os2/OS2/PrfDB/PrfDB.xs +++ b/os2/OS2/PrfDB/PrfDB.xs @@ -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); + diff --git a/os2/OS2/Process/Process.pm b/os2/OS2/Process/Process.pm index b862885b40..6ce93c049a 100644 --- a/os2/OS2/Process/Process.pm +++ b/os2/OS2/Process/Process.pm @@ -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 diff --git a/os2/OS2/Process/Process.xs b/os2/OS2/Process/Process.xs index 16b494d77c..159ef49a55 100644 --- a/os2/OS2/Process/Process.xs +++ b/os2/OS2/Process/Process.xs @@ -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) diff --git a/os2/OS2/REXX/REXX.xs b/os2/OS2/REXX/REXX.xs index f88d0afbc6..85944c75d2 100644 --- a/os2/OS2/REXX/REXX.xs +++ b/os2/OS2/REXX/REXX.xs @@ -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 |