diff --git a/PerlXlib_constants b/PerlXlib_constants index c26f32c..a4ca6ca 100644 --- a/PerlXlib_constants +++ b/PerlXlib_constants @@ -92,6 +92,7 @@ const_input i RevertToPointerRoot i RevertToNone const_error + i Success i BadAccess i BadAlloc i BadAtom @@ -124,6 +125,10 @@ const_cmap i AllocAll i AllocNone const_win + i AnyPropertyType + i PropModeReplace + i PropModeAppend + i PropModePrepend i Above i Below i BottomIf diff --git a/Xlib.xs b/Xlib.xs index 2a30723..95e78c5 100644 --- a/Xlib.xs +++ b/Xlib.xs @@ -687,6 +687,7 @@ XGetGeometry(dpy, wnd, root_out=NULL, x_out=NULL, y_out=NULL, width_out=NULL, he } /* perl-style API */ else if (ret) { + EXTEND(SP, 7); PUSHs(sv_2mortal(newSVuv(root))); PUSHs(sv_2mortal(newSViv(x))); PUSHs(sv_2mortal(newSViv(y))); @@ -696,6 +697,96 @@ XGetGeometry(dpy, wnd, root_out=NULL, x_out=NULL, y_out=NULL, width_out=NULL, he PUSHs(sv_2mortal(newSVuv(d))); } +void +XListProperties(dpy, wnd) + Display *dpy + Window wnd + INIT: + int num_props= 0, i; + AV *prop_av; + Atom *atom_array; + PPCODE: + atom_array= XListProperties(dpy, wnd, &num_props); + if (atom_array) { + EXTEND(SP, num_props); + for (i= 0; i < num_props; i++) + PUSHs(sv_2mortal(newSVuv(atom_array[i]))); + XFree(atom_array); + } + +int +XGetWindowProperty(dpy, wnd, prop_atom, long_offset, long_length, delete, req_type, actual_type_out, actual_format_out, nitems_out, bytes_after_out, data_out) + Display *dpy + Window wnd + Atom prop_atom + long long_offset + long long_length + Bool delete + Atom req_type + SV *actual_type_out + SV *actual_format_out + SV *nitems_out + SV *bytes_after_out + SV *data_out + INIT: + Atom actual_type; + int actual_format; + unsigned long nitems, bytes_after; + char *data= NULL; + CODE: + RETVAL = XGetWindowProperty(dpy, wnd, prop_atom, long_offset, long_length, delete, req_type, + &actual_type, &actual_format, &nitems, &bytes_after, (unsigned char**)&data); + if (RETVAL == Success) { + if (actual_format == 8) { + sv_setpvn(data_out, data, nitems); + } else if (actual_format == 16) { + sv_setpvn(data_out, data, nitems*2); + } else if (actual_format == 32) { + sv_setpvn(data_out, data, nitems*4); + } else { + XFree(data); + croak("Un-handled 'actual_format' value %d returned by XGetWindowProperty", actual_format); + } + XFree(data); + sv_setuv(actual_type_out, actual_type); + sv_setiv(actual_format_out, actual_format); + sv_setiv(nitems_out, nitems); + sv_setiv(bytes_after_out, bytes_after); + } + OUTPUT: + RETVAL + +void +XChangeProperty(dpy, wnd, prop_atom, type, format, mode, data, nelements) + Display *dpy + Window wnd + Atom prop_atom + Atom type + int format + int mode + SV *data + int nelements + INIT: + int bytelen= format == 8? nelements + : format == 16? nelements * 2 + : format == 32? nelements * 4 + : -1; + size_t svlen; + char *buffer; + CODE: + if (bytelen < 0) + croak("Un-handled 'format' value %d passed to XChangeProperty", format); + buffer= SvPV(data, svlen); + if (bytelen > svlen) + croak("'nelements' (%d) exceeds length of data (%d)", nelements, svlen); + XChangeProperty(dpy, wnd, prop_atom, type, format, mode, buffer, nelements); + +void +XDeleteProperty(dpy, wnd, prop_atom) + Display *dpy + Window wnd + Atom prop_atom + int XGetWMSizeHints(dpy, wnd, hints_out, supplied_out, property) Display * dpy @@ -4555,6 +4646,7 @@ BOOT: newCONSTSUB(stash, "RevertToParent", newSViv(RevertToParent)); newCONSTSUB(stash, "RevertToPointerRoot", newSViv(RevertToPointerRoot)); newCONSTSUB(stash, "RevertToNone", newSViv(RevertToNone)); + newCONSTSUB(stash, "Success", newSViv(Success)); newCONSTSUB(stash, "BadAccess", newSViv(BadAccess)); newCONSTSUB(stash, "BadAlloc", newSViv(BadAlloc)); newCONSTSUB(stash, "BadAtom", newSViv(BadAtom)); @@ -4584,6 +4676,10 @@ BOOT: newCONSTSUB(stash, "VisualAllMask", newSViv(VisualAllMask)); newCONSTSUB(stash, "AllocAll", newSViv(AllocAll)); newCONSTSUB(stash, "AllocNone", newSViv(AllocNone)); + newCONSTSUB(stash, "AnyPropertyType", newSViv(AnyPropertyType)); + newCONSTSUB(stash, "PropModeReplace", newSViv(PropModeReplace)); + newCONSTSUB(stash, "PropModeAppend", newSViv(PropModeAppend)); + newCONSTSUB(stash, "PropModePrepend", newSViv(PropModePrepend)); newCONSTSUB(stash, "Above", newSViv(Above)); newCONSTSUB(stash, "Below", newSViv(Below)); newCONSTSUB(stash, "BottomIf", newSViv(BottomIf)); diff --git a/lib/X11/Xlib.pm b/lib/X11/Xlib.pm index 1db8825..adfb22b 100644 --- a/lib/X11/Xlib.pm +++ b/lib/X11/Xlib.pm @@ -22,7 +22,7 @@ my %_constants= ( const_cmap => [qw( AllocAll AllocNone )], const_error => [qw( BadAccess BadAlloc BadAtom BadColor BadCursor BadDrawable BadFont BadGC BadIDChoice BadImplementation BadLength BadMatch BadName - BadPixmap BadRequest BadValue BadWindow )], + BadPixmap BadRequest BadValue BadWindow Success )], const_event => [qw( ButtonPress ButtonRelease CirculateNotify ClientMessage ColormapNotify ConfigureNotify CreateNotify DestroyNotify EnterNotify Expose FocusIn FocusOut GraphicsExpose GravityNotify KeyPress KeyRelease @@ -52,9 +52,10 @@ my %_constants= ( const_visual => [qw( VisualAllMask VisualBitsPerRGBMask VisualBlueMaskMask VisualClassMask VisualColormapSizeMask VisualDepthMask VisualGreenMaskMask VisualIDMask VisualRedMaskMask VisualScreenMask )], - const_win => [qw( Above Below BottomIf CenterGravity CopyFromParent - EastGravity ForgetGravity InputOnly InputOutput LowerHighest - NorthEastGravity NorthGravity NorthWestGravity Opposite RaiseLowest + const_win => [qw( Above AnyPropertyType Below BottomIf CenterGravity + CopyFromParent EastGravity ForgetGravity InputOnly InputOutput + LowerHighest NorthEastGravity NorthGravity NorthWestGravity Opposite + PropModeAppend PropModePrepend PropModeReplace RaiseLowest SouthEastGravity SouthGravity SouthWestGravity StaticGravity TopIf UnmapGravity WestGravity )], const_winattr => [qw( CWBackPixel CWBackPixmap CWBackingPixel CWBackingPlanes @@ -91,9 +92,10 @@ my %_functions= ( fn_thread => [qw( XInitThreads XLockDisplay XUnlockDisplay )], fn_vis => [qw( XCreateColormap XFreeColormap XGetVisualInfo XMatchVisualInfo XVisualIDFromVisual )], - fn_win => [qw( XChangeWindowAttributes XCirculateSubwindows XConfigureWindow - XCreateSimpleWindow XCreateWindow XDefineCursor XDestroyWindow - XGetGeometry XGetWMNormalHints XGetWMSizeHints XGetWindowAttributes + fn_win => [qw( XChangeProperty XChangeWindowAttributes XCirculateSubwindows + XConfigureWindow XCreateSimpleWindow XCreateWindow XDefineCursor + XDeleteProperty XDestroyWindow XGetGeometry XGetWMNormalHints + XGetWMSizeHints XGetWindowAttributes XGetWindowProperty XListProperties XLowerWindow XMapWindow XMoveResizeWindow XMoveWindow XQueryTree XRaiseWindow XReparentWindow XResizeWindow XRestackWindows XSetWMNormalHints XSetWMSizeHints XSetWindowBackground @@ -922,6 +924,57 @@ front (C), or the front-most to the back Reset the stacking order of the specified windows, from front to back. +=head3 XListProperties + + my @prop_atoms= XListProperties($display, $window); + print "Window has these properties: ".join(", ", @{ XGetAtomNames($display, \@prop_atoms, 1) }); + +Returns an arrayref of all defined properties on the specified window. + +=head3 XGetWindowProperty + + my $success= XGetWindowProperty($display, $wnd, $prop_atom, $offset, $length, $delete, $req_type, + my $actual_type, my $actual_format, my $nitems, my $bytes_after, my $data); + +Welcome to the wonderful world of X11 Window Properties! You pick the +property using C<$prop_atom> (see L) and then request some range +of the bytes that compose it (using C<$offset>*4 and C<$length>*4, which are +a count of 4-byte units, not bytes) request to delete it with C<$delete>, +request the resource be given to you as C<$req_type> (also an Atom), and then +receive all the actual values in the last 5 variables. + +C<$actual_format> is either 8, 16, or 32 indicating the multiplier for +C<$nitems>. But you can just check C to save time. + +The details are complicated enough you should go read the X11 docs, but a quick +example is: + + my $netwmname= XInternAtom($display, "_NET_WM_NAME"); + my $type_utf8= XInternAtom($display, "UTF8_STRING"); + if (XGetWindowProperty($display, $wnd, $netwmname, 0, 32, 0, $type_utf8, + my $actual_type, my $actual_format, my $n, my $remaining, my $data) + ) { + say $data; # should check $actual_type, but it's probably readable text. + say "window title was longer than 128 bytes" if $remaining > 0; + } + +=head3 XChangeProperty + + XChangeProperty($display, $wnd, $prop_atom, $type_atom, $format, $mode, $data, $nitems); + +C<$prop_atom> determines what property is being written. C<$type_atom> +declares the logical type of the data. C<$format> is 8, 16, or 32 to determine +the word size of the data (used by X server for endian swapping). C<$mode> is +one of: C, C, C. C<$data> +is a scalar that must be at least as long as C<$nitems> * C<$format> bits. + +=head3 XDeleteProperty + + XDeleteProperty($display, $window, $prop_atom); + +Deletes the property from the window if it exists. No error is raised if it +doesn't exist. + =head3 XGetWMNormalHints my ($hints_out, $supplied_fields_out); diff --git a/t/42-window.t b/t/42-window.t index 024e9a3..54397a0 100644 --- a/t/42-window.t +++ b/t/42-window.t @@ -3,7 +3,7 @@ use strict; use warnings; use Test::More; -use X11::Xlib qw( :fn_win :const_win :const_winattr :const_sizehint RootWindow XSync None ); +use X11::Xlib qw( :fn_win :const_win :const_winattr :const_sizehint RootWindow XSync None Success ); plan skip_all => "No X11 Server available" unless $ENV{DISPLAY}; @@ -20,6 +20,21 @@ is( err{ $win_id= XCreateWindow(@args) }, '', 'CreateWindow' ) or diag explain \@args; ok( $win_id > 0, 'got window id' ); +my $netwmname= $dpy->XInternAtom("_NET_WM_NAME", 0); +my $type_utf8= $dpy->XInternAtom("UTF8_STRING", 0); +is_deeply( [ XListProperties($dpy, $win_id) ], [], 'no window properties yet' ); +XChangeProperty($dpy, $win_id, $netwmname, $type_utf8, 8, PropModeReplace, "Hello World", 11); +is_deeply( [ XListProperties($dpy, $win_id) ], [ $netwmname ], 'window has title property' ); +ok( Success == XGetWindowProperty($dpy, $win_id, $netwmname, 0, 32, 0, $type_utf8, + my $actual_type, my $actual_format, my $n, my $remaining, my $data), 'XGetWindowProperty' ); +is( $actual_type, $type_utf8, 'correct type' ); +is( $actual_format, 8, 'correct format' ); +is( $n, 11, '11 bytes' ); +is( $remaining, 0, 'no missing bytes' ); +is( $data, 'Hello World', 'correct string' ); +XDeleteProperty($dpy, $win_id, $netwmname); +is_deeply( [ XListProperties($dpy, $win_id) ], [], 'no window properties yet' ); + is( err{ XMapWindow($dpy, $win_id); }, '', 'XMapWindow' ); $dpy->XSync;