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