Added general-purpose window property functions

I believe these are the underlying read/write routines used by all the other get/set struct functions. This should allow access to all the properties that the library doesn't have specific support for yet.
nijssen · May 2, 2017 · cf766e0 · cf766e0
1 parent 5f6a4f7
commit cf766e0
Show file tree

Hide file tree

Showing 4 changed files with 177 additions and 8 deletions.
diff --git 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
@@ -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
@@ -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<direction == RaiseLowest>), 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</XInternAtom>) 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<length($data)> 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<PropModeReplace>, C<PropModePrepend>, C<PropModeAppend>.  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
@@ -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;