diff options
Diffstat (limited to 'os2/OS2/Process/Process.pm')
| -rw-r--r-- | os2/OS2/Process/Process.pm | 276 |
1 files changed, 265 insertions, 11 deletions
diff --git a/os2/OS2/Process/Process.pm b/os2/OS2/Process/Process.pm index 29e4d9b433..956e8fd935 100644 --- a/os2/OS2/Process/Process.pm +++ b/os2/OS2/Process/Process.pm @@ -101,6 +101,7 @@ our @EXPORT = qw( ChildWindows out_codepage out_codepage_set + process_codepage_set in_codepage in_codepage_set cursor @@ -124,6 +125,45 @@ our @EXPORT = qw( SetWindowPtr SetWindowULong SetWindowUShort + TopLevel + FocusWindow_set_keep_Zorder + + ActiveDesktopPathname + InvalidateRect + CreateFrameControl + ClipbrdFmtInfo + ClipbrdOwner + ClipbrdViewer + ClipbrdData + OpenClipbrd + CloseClipbrd + ClipbrdData_set + ClipbrdOwner_set + ClipbrdViewer_set + EnumClipbrdFmts + EmptyClipbrd + AddAtom + FindAtom + DeleteAtom + AtomUsage + AtomName + AtomLength + SystemAtomTable + CreateAtomTable + DestroyAtomTable + + _ClipbrdData_set + ClipbrdText + ClipbrdText_set + + _MessageBox + MessageBox + _MessageBox2 + MessageBox2 + LoadPointer + SysPointer + Alarm + FlashWindow get_title set_title @@ -178,7 +218,7 @@ sub import { 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($_) : $_ + /^(HWND|WM|SC|SWP|WC|PROG|QW|EDI|WS|QWS|QWP|QWL|FF|FI|LS|FS|FCF|BS|MS|TBM|CF|CFI|FID|MB|MBID|CF|CFI|SPTR)_/ ? const_import($_) : $_ } @_); goto &Exporter::import if @_ > 1 or $ini == 0; } @@ -335,6 +375,117 @@ sub ChildWindows (;$) { @kids; } +sub TopLevel ($) { + my $d = DesktopWindow; + my $w = shift; + while (1) { + my $p = QueryWindow $w, 5; # QW_PARENT; + return $w if not $p or $p == $d; + $w = $p; + } +} + +sub FocusWindow_set_keep_Zorder ($) { + my $w = shift; + my $t = TopLevel $w; + my $b = hWindowPos($t)->{behind}; # we are behind this + EnableWindowUpdate($t, 0); + FocusWindow_set($w); +# sleep 1; # Make flicker stronger when present + hWindowPos_set {behind => $b}, $t; + EnableWindowUpdate($t, 1); +} + +sub ClipbrdText (@) { + my $morph = OS2::localMorphPM->new(0); + OpenClipbrd(); + my $txt = unpack 'p', pack 'L', ClipbrdData @_; + CloseClipbrd(); + $txt; +} + +sub ClipbrdText_set ($;$) { + my $morph = OS2::localMorphPM->new(0); + OpenClipbrd(); + EmptyClipbrd(); # It may contain other types + my ($txt, $no_convert_nl) = (shift, shift); + ClipbrdData_set($txt, !$no_convert_nl, @_); + CloseClipbrd(); +} + +sub MessageBox ($;$$$$$) { + my $morph = OS2::localMorphPM->new(0); + die "MessageBox needs text" unless @_; + push @_ , ($0 eq '-e' ? "Perl one-liner's message" : "$0 message") if @_ == 1; + &_MessageBox; +} + +my %pointers; + +sub get_pointer ($;$$) { + my $id = $_[0]; + return $pointers{$id} if exists $pointers{$id}; + $pointers{$id} = &SysPointer; +} + +# $button needs to be of the form 'String', ['String'] or ['String', flag]. +# If ['String'], it is assumed the default button; same for 'String' if $only +# is set. +sub process_MB2 ($$;$) { + die "process_MB2() needs 2 arguments, got '@_'" unless @_ == 2 or @_ == 3; + my ($button, $ret, $only) = @_; + # default is BS_PUSHBUTTON, add BS_DEFAULT if $only is set + $button = [$button, $only ? 0x400 : 0] unless ref $button eq 'ARRAY'; + push @$button, 0x400 if @$button == 1; # BS_PUSHBUTTON|BS_DEFAULT + die "Button needs to be of the form 'String', ['String'] or ['String', flag]" + unless @$button == 2; + pack "Z71 x L l", $button->[0], $ret, $button->[1]; # name, retval, flag +} + +# If one button, make it the default one even if it is of 'String' => val form. +# If icon is of the form 'SP#<number>', load this via SysPointer. +sub process_MB2_INFO ($;$$$) { + my $l = 0; + my $out; + die "process_MB2_INFO() needs 1..4 arguments" unless @_ and @_ < 5; + my $buttons = shift; + die "Buttons array should consist of pairs" if @$buttons % 2; + + push @_, 0 unless @_; # Icon id (pointer) + # Box flags (MB_MOVABLE and MB_INFORMATION or MB_CUSTOMICON) + push @_, ($_[0] ? 0x4080 : 0x4030) unless @_ > 1; + push @_, 0 unless @_ > 2; # Notify window + + my ($icon, $style, $notify) = (shift, shift, shift); + $icon = get_pointer $1 if $icon =~ /^SP#(\d+)\z/; + $out = pack "L L L L", # icon, #buttons, style, notify, buttons + $icon, @$buttons/2, $style, $notify; + $out .= join '', + map process_MB2($buttons->[2*$_], $buttons->[2*$_+1], @$buttons == 2), + 0..@$buttons/2-1; + pack('L', length(pack 'L', 0) + length $out) . $out; +} + +# MessageBox2 'Try this', OS2::Process::process_MB2_INFO([['Dismiss', 0] => 0x1000], OS2::Process::get_pointer(22),0x4080,0), 'me', 1, 0, 0 +# or the shortcut +# MessageBox2 'Try this', [[['Dismiss', 0] => 0x1000], 'SP#22'], 'me' +# 0x80 means MB_CUSTOMICON (does not focus?!). This focuses: +# MessageBox2 'Try this', [[['Dismiss',0x400] => 0x1000], 0, 0x4030,0] +# 0x400 means BS_DEFAULT. This is the same as the shortcut +# MessageBox2 'Try this', [[Dismiss => 0x1000]] +sub MessageBox2 ($;$$$$$) { + my $morph = OS2::localMorphPM->new(0); + die "MessageBox needs text" unless @_; + push @_ , [[Dismiss => 0x1000], # Name, retval (BS_PUSHBUTTON|BS_DEFAULT) + #0, # get_pointer(11), # SPTR_ICONINFORMATION + #0x4030, # MB_MOVEABLE | MB_INFORMATION + #0, # Notify window; was 1==HWND_DESKTOP + ] if @_ == 1; + push @_ , ($0 eq '-e' ? "Perl one-liner's message" : "$0's message") if @_ == 2; + $_[1] = &process_MB2_INFO(@{$_[1]}) if ref($_[1]) eq 'ARRAY'; + &_MessageBox2; +} + # backward compatibility *set_title = \&Title_set; *get_title = \&Title; @@ -551,7 +702,19 @@ gets a buffer with characters and attributes of the screen. =item C<screen_set($buffer)> -restores the screen given the result of screen(). +restores the screen given the result of screen(). E.g., if the file +C<$file> contains the sceen contents, then + + open IN, $file or die; + binmode IN; + read IN, $in, -s IN; + $s = screen; + $in .= qq(\0) x (length($s) - length $in); + substr($in, length $s) = ''; + screen_set $in; + +will restore the screen content even if the height of the window +changed (if the width changed, more manipulation is needed). =back @@ -705,9 +868,9 @@ titlebar of the current window. 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)> +=item C<SwitchToProgram([$sw_entry])> -switch to session given by a switch list handle. +switch to session given by a switch list handle (defaults to the entry of our process). 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 @@ -824,10 +987,18 @@ to use. E.g, the first entry in program_entries() is the C<Ctrl-Esc> list. To show an application, use either one of WinShowWindow( $hwnd, 1 ); - SetFocus( $hwnd ); + FocusWindow_set( $hwnd ); SwitchToProgram($switch_handle); -(Which work with alternative focus-to-front policies?) Requires (morphing to) PM. +(Which work with alternative focus-to-front policies?) Requires +(morphing to) PM. + +Switching focus to currently-unfocused window moves the window to the +front in Z-order; use FocusWindow_set_keep_Zorder() to avoid this. + +=item C<FocusWindow_set_keep_Zorder($hwnd)> + +same as FocusWindow_set(), but preserves the Z-order of windows. =item C<ActiveWindow([$parentHwnd])> @@ -1013,6 +1184,16 @@ item list when beginning is reached. =back +=item DesktopWindow() + +gets the actual window handle of the PM desktop; most APIs accept the +pseudo-handle C<HWND_DESKTOP> instead. Keep in mind that the WPS +desktop (one with WindowText() being C<"Desktop">) is a different beast?! + +=item TopLevel($hwnd) + +gets the toplevel window of $hwnd. + =item ResetWinError() Resets $^E. One may need to call it before the C<Win*>-class APIs which may @@ -1031,6 +1212,77 @@ This function is normally not needed. Not exported by default. =back +=head2 Control of the PM data + +=over + +=item ActiveDesktopPathname() + +gets the path of the directory which corresponds to Desktop. + +=item ClipbrdText() + +gets the content of the clipboard. An optional argument is the format +of the data in the clipboard (defaults to C<CF_TEXT>). + +Note that the usual convention is to have clipboard data with +C<"\r\n"> as line separators. + +=item ClipbrdText_set($txt) + +sets the text content of the clipboard. Unless the optional argument +is TRUE, will convert newlines to C<"\r\n">. Another optional +argument is the format of the data in the clipboard (defaults to +C<CF_TEXT>). + +=item InvalidateRect + +=item CreateFrameControl + +=item ClipbrdFmtInfo + +=item ClipbrdOwner + +=item ClipbrdViewer + +=item ClipbrdData + +=item OpenClipbrd + +=item CloseClipbrd + +=item ClipbrdData_set + +=item ClipbrdOwner_set + +=item ClipbrdViewer_set + +=item EnumClipbrdFmts + +=item EmptyClipbrd + +=item AddAtom + +=item FindAtom + +=item DeleteAtom + +=item AtomUsage + +=item AtomName + +=item AtomLength + +=item SystemAtomTable + +=item CreateAtomTable + +=item DestroyAtomTable + +Low-level methods to access clipboard and the atom table(s). + +=back + =head1 OS2::localMorphPM class This class morphs the process to PM for the duration of the given scope. @@ -1072,12 +1324,14 @@ Add tests for: scrsize scrsize_set -Document: -Query/SetWindowULong/Short/Ptr, SetWindowBits. +Document and test: Query/SetWindowULong/Short/Ptr, SetWindowBits. +InvalidateRect, CreateFrameControl, ClipbrdFmtInfo ClipbrdOwner +ClipbrdViewer ClipbrdData OpenClipbrd CloseClipbrd ClipbrdData_set +ClipbrdOwner_set ClipbrdViewer_set EnumClipbrdFmts EmptyClipbrd +AddAtom FindAtom DeleteAtom AtomUsage AtomName AtomLength +SystemAtomTable CreateAtomTable DestroyAtomTable -Implement InvalidateRect, -CreateFrameControl. ClipbrdFmtInfo, ClipbrdData, OpenClipbrd, CloseClipbrd, -ClipbrdData_set, EnumClipbrdFmt, EmptyClipbrd. SOMETHINGFROMMR. +Implement SOMETHINGFROMMR. >But I wish to change the default button if the user enters some |