From 428bc37d2f5b7de6a2014bd5e23ad443c73e2cfe Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Sun, 15 Aug 2021 03:20:16 -0400 Subject: [PATCH 1/6] add support for the simpler functions in Xresources.h --- MANIFEST | 3 + Makefile.PL | 3 +- Xlib.xs | 110 ++++++++++++++++++++++++++++ cpanfile | 5 ++ lib/X11/Xlib.pm | 138 ++++++++++++++++++++++++++++++++++++ lib/X11/Xlib/XrmDatabase.pm | 56 +++++++++++++++ t/50-resources.t | 130 +++++++++++++++++++++++++++++++++ t/xresources | 5 ++ typemap | 53 ++++++++++++++ 9 files changed, 502 insertions(+), 1 deletion(-) create mode 100644 lib/X11/Xlib/XrmDatabase.pm create mode 100644 t/50-resources.t create mode 100644 t/xresources diff --git a/MANIFEST b/MANIFEST index 55f3446..3c7e36a 100644 --- a/MANIFEST +++ b/MANIFEST @@ -24,6 +24,7 @@ lib/X11/Xlib/XEvent.pm lib/X11/Xlib/XID.pm lib/X11/Xlib/XRectangle.pm lib/X11/Xlib/XRenderPictFormat.pm +lib/X11/Xlib/XrmDatabase.pm lib/X11/Xlib/XSetWindowAttributes.pm lib/X11/Xlib/XSizeHints.pm lib/X11/Xlib/XVisualInfo.pm @@ -45,5 +46,7 @@ t/37-input-kb.t t/40-screen-attrs.t t/42-window.t t/43-pixmap.t +t/50-resources.t t/70-xcomposite.t +t/xresources t/lib/X11/SandboxServer.pm diff --git a/Makefile.PL b/Makefile.PL index c68b57f..ef73a17 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -13,7 +13,8 @@ BEGIN { 'ExtUtils::MakeMaker' => 0, ); %TEST_REQUIRES= ( - 'Test::More' => 0, + 'Test::More' => 1.001014, + 'Test::TempDir::Tiny' => 0, ); %PREREQ_PM= ( 'Try::Tiny' => 0, diff --git a/Xlib.xs b/Xlib.xs index e379f29..0116d38 100644 --- a/Xlib.xs +++ b/Xlib.xs @@ -9,6 +9,7 @@ #include #include #include +#include #include #ifdef HAVE_XCOMPOSITE #include @@ -23,6 +24,8 @@ #include "PerlXlib.h" void PerlXlib_sanity_check_data_structures(); +typedef XrmDatabase XrmDatabaseMaybe; + MODULE = X11::Xlib PACKAGE = X11::Xlib void @@ -1619,6 +1622,113 @@ _install_error_handlers(nonfatal,fatal) CODE: PerlXlib_install_error_handlers(nonfatal, fatal); +# Xresources Functions (fn_resources) ------------------------------------------------------- + +void +XrmInitialize() + +XrmDatabase +XrmGetFileDatabase( filename ) + char *filename + +void +XrmPutFileDatabase( database, stored_db ) + XrmDatabase database + char *stored_db + +char * +XResourceManagerString(display) + Display *display + +char * +XScreenResourceString(screen) + Screen *screen + +XrmDatabase +XrmGetStringDatabase(data) + char *data + +const char * +XrmLocaleOfDatabase(database) + XrmDatabase database + +void +XrmDestroyDatabase(database) + XrmDatabase database + +void +XrmSetDatabase( display, database) + Display *display + XrmDatabase database + +XrmDatabase +XrmGetDatabase( display ) + Display *display + +Status +XrmCombineFileDatabase(filename, IN_OUT XrmDatabaseMaybe target_db, override ) + char* filename + Bool override + +void +XrmCombineDatabase( IN_OUT XrmDatabase source_db, IN_OUT XrmDatabaseMaybe target_db, override ) + Bool override + CODE: + XrmCombineDatabase(source_db, &target_db, override); + source_db = NULL; /* source_db is destroyed by XrmCombineDatabase */ + +void +XrmMergeDatabases(IN_OUT XrmDatabase source_db, IN_OUT XrmDatabaseMaybe target_db ) + CODE: + XrmMergeDatabases(source_db, &target_db ); + source_db = NULL; /* source_db is destroyed by XrmMergeDatabases */ + +# can't return Bool (as woule be appropriate); see https://github.com/Perl/perl5/issues/19054 +int +XrmGetResource( database, str_name, str_class, OUTLIST char* str_type_return, OUTLIST XrmValue value_return ) + XrmDatabase database + const char* str_name + const char* str_class + CODE: + RETVAL = XrmGetResource( database, str_name, str_class, &str_type_return, &value_return ); + if ( RETVAL && 0 == strcmp(str_type_return, "String" ) ) + value_return.size -= 1; /* don't count the trailiing null */ + OUTPUT: + RETVAL + +void +XrmPutResource( IN_OUT XrmDatabaseMaybe database, specifier, type, value ) + const char* specifier + const char* type + XrmValue &value; + CODE: + /* they said it was a string, so take them at their word and add the + trailing NUL to our count */ + if ( 0 == strcmp(type, "String" ) ) + value.size += 1; + XrmPutResource( &database, specifier, type, &value ); + OUTPUT: + database + +void +XrmPutStringResource( IN_OUT XrmDatabaseMaybe database, specifier, value ) + const char* specifier + const char* value + +void +XrmPutLineResource( IN_OUT XrmDatabaseMaybe database, line ) + const char* line + +MODULE = X11::Xlib PACKAGE = X11::Xlib::XrmDatabase + +void +DESTROY( IN_OUT XrmDatabase database ) + CODE: + XrmDestroyDatabase( database ); + database = NULL; + +MODULE = X11::Xlib PACKAGE = X11::Xlib + # Xcomposite Extension () ---------------------------------------------------- #ifdef XCOMPOSITE_VERSION diff --git a/cpanfile b/cpanfile index 24382c8..692817f 100644 --- a/cpanfile +++ b/cpanfile @@ -3,3 +3,8 @@ requires 'Test::More' => "0"; requires 'Devel::CheckLib' => "1.03"; requires "ExtUtils::Depends" => "0.405"; requires "Try::Tiny" => "0"; + +on test => sub { + requires 'Test::TempDir::Tiny'; + requires 'Test::More' => 1.001014; +}; \ No newline at end of file diff --git a/lib/X11/Xlib.pm b/lib/X11/Xlib.pm index 0eae2b7..ef7b2bc 100644 --- a/lib/X11/Xlib.pm +++ b/lib/X11/Xlib.pm @@ -86,6 +86,11 @@ my %_functions= ( char_to_keysym codepoint_to_keysym keysym_to_char keysym_to_codepoint )], fn_pix => [qw( XCreateBitmapFromData XCreatePixmap XCreatePixmapFromBitmapData XFreePixmap )], + fn_resources => [qw( XResourceManagerString XScreenResourceString + XrmCombineDatabase XrmCombineFileDatabase XrmDestroyDatabase + XrmGetFileDatabase XrmGetResource XrmGetStringDatabase XrmInitialize + XrmLocaleOfDatabase XrmMergeDatabases XrmPutFileDatabase + XrmPutLineResource XrmPutResource XrmPutStringResource XrmSetDatabase )], fn_screen => [qw( DefaultColormap DefaultDepth DefaultGC DefaultScreen DefaultVisual DisplayHeight DisplayHeightMM DisplayWidth DisplayWidthMM RootWindow ScreenCount )], @@ -1361,6 +1366,139 @@ Return the key code corresponding to C<$keysym> in the current mapping. Make the X server emit a sound. +=head2 RESOURCE FUNCTIONS + +These functions provide an interface to the X resources manager and databases. Functions +whose first parameter is a databse handle may be used as methods on the handle by importing +L. + +=head3 XrmInitialize + + XrmInitialize(); + +Initialize the resource manager. + +=head3 XrmGetFileDatabase + + $database = XrmGetFileDatabase( $filename ); + +Create a resource database from an X resource file. + +=head3 XrmPutFileDatabase + + XrmPutFileDatabase( $database, $filename ); + +Write the database to the specified file. + +=head3 XResourceManagerString + + $string = XResourceManagerString( $display ); + +Return the C property from the root window of screen zero. + +=head3 XScreenResourceString + + $string = XScreenResourceString( $screen ); + +Return the C property from the root window of the specified screen. + +=head3 XrmGetStringDatabase + + $database = XrmGetStringDatabase( $data ); + +Create a new database from resources specified in the string specified in C<$data>. The string +should have the same format as an X resource file. + +=head3 XrmLocaleOfDatabase + + $string = XrmLocaleOfDatabase( $database ); + +Return the name of the locale bound to the database. + +=head3 XrmDestroyDatabase(database) + + XrmDestroyDatabase( $database ); + +Destroy the specified database. A database is also automatically destroyed when it goes out of scope. + +=head3 XrmSetDatabase + + XrmSetDatabase( $display, $database ); + +Associate the resource database with the display. + +=head3 XrmGetDatabase + + $database = XrmGetDatabase( $display ); + +Return the database associated with the display. + +=head3 XrmCombineFileDatabase + + $status = XrmCombineFileDatabase( $filename, $target_db, $override ); + +Merge the contents of a resource file into a database. If C<$target_db> +is undef or not an existing database, it will be set to a newly +created database. + +If C<$override> is true, entries in C<$filename> will replace those in +C<$target_db>. + +Returns zero if there is an error. + +=head3 XrmCombineDatabase + + XrmCombineDatabase( $source_db, $target_db, $override ); + +Merge the contents of C<$source_db> into C<$target_db>. +If C<$override> is true, entries in C<$source_db> will replace those +in C<$target_db>. + +If C<$target_db> is undef or not an existing database, it be set to +C<$source_db>. + +C<$source_db> will be invalidated by this function. + +=head3 XrmMergeDatabases + + XrmMergeDatabases( $source_db, $target_db ); + +The same as calling L with C<$override = 1>. + +=head3 XrmGetResource + + ($bool, $type, $value ) = XrmGetResource( $database, $name, $class ); + +Retrieve a resource with the given C<$name> and C<$class>. C<$bool> is true if +the resource was found. If C<$type> is C, C<$value> contains a string. +Otherwise, it is up to the user to decode it, + +=head3 XrmPutResource( IN_OUT XrmDatabaseMaybe database, specifier, type, value ) + + XrmPutResource( $database, $specifier, $type, $value ); + +Store the resource in the specified database. If C<$database> is +C or not an existing database, a new one will be created and +the handle stored in C<$database>. If C<$type> is C, the +C<$value> is assumed to be a Perl string and will be stored as a +string, otherwise it is stored as is. + +=head3 XrmPutStringResource( IN_OUT XrmDatabaseMaybe database, specifier, value ) + + XrmPutStringResource( $database, $specifier, $value ); + +Store the resource as a string the specified database. If C<$database> is +C or not an existing database, a new one will be created and +the handle stored in C<$database>. + +=head3 XrmPutLineResource( IN_OUT XrmDatabaseMaybe database, line ) + + XrmPutLineResource( $database, $line ); + +Store the resource record in the database. If C<$database> is +C or not an existing database, a new one will be created and +the handle stored in C<$database>. + =head2 EXTENSION XCOMPOSITE This is an optional extension. If you have Xcomposite available when this diff --git a/lib/X11/Xlib/XrmDatabase.pm b/lib/X11/Xlib/XrmDatabase.pm new file mode 100644 index 0000000..47f1d38 --- /dev/null +++ b/lib/X11/Xlib/XrmDatabase.pm @@ -0,0 +1,56 @@ +package X11::Xlib::XrmDatabase; + +use strict; +use warnings; + +use X11::Xlib; + +# All modules in dist share a version +our $VERSION = '0.20'; + +*XrmPutFileDatabase = \&X11::Xlib::XrmPutFileDatabase; +*XrmLocaleOfDatabase = \&X11::Xlib::XrmLocaleOfDatabase; +*XrmDestroyDatabase = \&X11::Xlib::XrmDestroyDatabase; +*XrmCombineDatabase = \&X11::Xlib::XrmCombineDatabase; +*XrmMergeDatabases = \&X11::Xlib::XrmMergeDatabases; +*XrmGetResource = \&X11::Xlib::XrmGetResource; +*XrmPutResource = \&X11::Xlib::XrmPutResource; +*XrmPutStringResource = \&X11::Xlib::XrmPutStringResource; +*XrmPutLineResource = \&X11::Xlib::XrmPutLineResource; + +1; + +=head1 NAME + +X11::Xlib::XrmDatabase - Shadow class for X Resource Manager databases + + +=head1 SYNOPSIS + +To make the methods available: + + use X11::Xlib::XrmDatabase; + +Otherwise, they are as available as functions when using L. + +=head1 DESCRIPTION + +See L for more details. Any C +function whose first parameter is an X Resource database handle can be +used as a method after importing this module. + +=head1 AUTHOR + +Diab Jerius, Edjerius@cpan.orgE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2021 by Diab Jerius + +Copyright (C) 2021 by Smithsonian Astrophysical Observatory. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.10.0 or, +at your option, any later version of Perl 5 you may have available. + +=cut diff --git a/t/50-resources.t b/t/50-resources.t new file mode 100644 index 0000000..6f06f86 --- /dev/null +++ b/t/50-resources.t @@ -0,0 +1,130 @@ +#! /usr/bin/env perl + +use v5.10; + +use strict; +use warnings; + +use Test::More 1.001014; +use Test::TempDir::Tiny; + +use X11::Xlib qw( :fn_resources ); +use X11::Xlib::XrmDatabase; + +my $HALF1 = <<'END'; +xmh*Paned*activeForeground: red +*incorporate.Foreground: blue +END + +my $HALF2 = <<'END'; +xmh.toc*Command*activeForeground: green +xmh.toc*?.Foreground: white +xmh.toc*Command.activeForeground: black +END + +my $StringDB = $HALF1 . $HALF2; + + + +XrmInitialize(); + +sub test_db { + my $db = shift; + + my ( $bool, $type, $value ) = $db->XrmGetResource( + 'xmh.toc.messagefunctions.incorporate.activeForeground', + 'Xmh.Paned.Box.Command.Foreground' + ); + + is( !!$bool, 1, 'success' ); + is( $type, 'String', 'type' ); + is( $value, 'black', "value" ); +} + +subtest 'File' => sub { + test_db( XrmGetFileDatabase( 't/xresources' ) ); +}; + +subtest String => sub { + test_db( XrmGetStringDatabase( $StringDB ) ) +}; + +sub Put { + my ( $db, $put ) = @_; + $put->( $db, 'xmh*Paned*activeForeground', 'red' ); + $put->( $db, '*incorporate.Foreground', 'blue' ); + $put->( $db, 'xmh.toc*Command*activeForeground', 'green' ); + $put->( $db, 'xmh.toc*?.Foreground', 'white' ); + $put->( $db, 'xmh.toc*Command.activeForeground', 'black' ); + test_db( $db ); +} + +sub test_put { + my $put = shift; + subtest 'explicit create' => \&Put, XrmGetStringDatabase( '' ), $put; + subtest 'implicit create' => \&Put, undef, $put; +} + +subtest Put => sub { + test_put sub { XrmPutResource( $_[0], $_[1], 'String', $_[2] ) }; +}; + +subtest PutString => sub { + test_put sub { XrmPutStringResource(@_) }; +}; + +subtest PutLine => sub { + test_put sub { XrmPutLineResource( $_[0], $_[1] . ': ' . $_[2] ) }; +}; + +subtest PutFileDatabase => sub { + my $db = XrmGetStringDatabase( $StringDB ); + + in_tempdir "method" => sub { + $db->XrmPutFileDatabase( "resources" ); + my $ndb = XrmGetFileDatabase( "resources" ); + test_db( $ndb ); + }; + +}; + +subtest CombineFileDatabase => sub { + my $filename = 'resources'; + + subtest methods => sub { + in_tempdir "PutFile" => sub { + my $source_db = XrmGetStringDatabase( $HALF1 ); + $source_db->XrmPutFileDatabase( $filename ); + my $target_db = XrmGetStringDatabase( $HALF2 ); + my $ok = XrmCombineFileDatabase( $filename, $target_db, 1 ); + ok( $ok, 'XrmCombineFileDatabase' ); + test_db( $target_db ); + }; + }; + +}; + +subtest CombineDatabase => sub { + + subtest methods => sub { + my $source_db = XrmGetStringDatabase( $HALF1 ); + my $target_db = XrmGetStringDatabase( $HALF2 ); + $source_db->XrmCombineDatabase( $target_db, 1 ); + test_db( $target_db ); + }; + +}; + +subtest MergeDatabases => sub { + + subtest methods => sub { + my $source_db = XrmGetStringDatabase( $HALF1 ); + my $target_db = XrmGetStringDatabase( $HALF2 ); + $source_db->XrmMergeDatabases( $target_db ); + test_db( $target_db ); + }; + +}; + + +done_testing; diff --git a/t/xresources b/t/xresources new file mode 100644 index 0000000..6750edb --- /dev/null +++ b/t/xresources @@ -0,0 +1,5 @@ +xmh*Paned*activeForeground: red +*incorporate.Foreground: blue +xmh.toc*Command*activeForeground: green +xmh.toc*?.Foreground: white +xmh.toc*Command.activeForeground: black diff --git a/typemap b/typemap index 9e1f64c..63d28a8 100644 --- a/typemap +++ b/typemap @@ -28,8 +28,13 @@ PictFormat O_X11_Xlib_XID Atom T_UV Time T_UV Bool T_BOOL +Status T_IV KeyCode T_IV KeySym T_IV +Xpointer T_PV +XrmDatabase T_PTROBJ_SPECIAL +XrmDatabaseMaybe T_PTROBJ_SPECIAL_Maybe +XrmValue O_X11_Xlib_XrmValue INPUT O_X11_Xlib @@ -117,3 +122,51 @@ O_X11_Xlib_OpaqueOrNull dpy, $var, \"X11::Xlib::@{[ $type =~ /(\w+?)OrNull/ ]}\", SVt_PVMG, 1)); else sv_setsv($arg, &PL_sv_undef); + +INPUT +O_X11_Xlib_XrmValue + ${var}.size = SvCUR($arg); + ${var}.addr = SvPV_nolen($arg); + +OUTPUT +O_X11_Xlib_XrmValue + sv_setpvn($arg, ${var}.addr, ${var}.size ); + +INPUT +T_PTROBJ_SPECIAL + if (sv_isobject($arg) && sv_derived_from($arg, \"X11::Xlib::${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\")){ + IV tmp = SvIV((SV*)SvRV($arg)); + $var = INT2PTR($type, tmp); + } + else + croak(\"$var is not of type X11::Xlib::${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\"); + +OUTPUT +T_PTROBJ_SPECIAL + if(sv_isobject($arg) ) { + SV* tmp = (SV*)(SvRV($arg) ); + sv_setiv( tmp, PTR2IV($var) ); + } + else + sv_setref_pv($arg, \"X11::Xlib::${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\", (void*)$var); + + +INPUT +T_PTROBJ_SPECIAL_Maybe + if (sv_isobject($arg) && sv_derived_from($arg, \"X11::Xlib::${(my $ntt=$ntype)=~s/_/::/g; $ntt =~ s/Maybe$//;\$ntt}\")){ + IV tmp = SvIV((SV*)SvRV($arg)); + $var = INT2PTR($type, tmp); + } + else { + $var = NULL; + } + +OUTPUT +T_PTROBJ_SPECIAL_Maybe + if(sv_isobject($arg) ) { + SV* tmp = (SV*)(SvRV($arg) ); + sv_setiv( tmp, PTR2IV($var) ); + } + else + sv_setref_pv($arg, \"X11::Xlib::${(my $ntt=$ntype)=~s/_/::/g; $ntt =~ s/Maybe$//;\$ntt}\", + (void*)$var); From e81e3dbc073ff43c905d07bb256e8bc1fa31e6eb Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Mon, 16 Aug 2021 11:50:44 -0400 Subject: [PATCH 2/6] invalidate database pointer during an explicit call to XrmDestroyDatabase --- Xlib.xs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/Xlib.xs b/Xlib.xs index 0116d38..1cf9071 100644 --- a/Xlib.xs +++ b/Xlib.xs @@ -1653,8 +1653,11 @@ XrmLocaleOfDatabase(database) XrmDatabase database void -XrmDestroyDatabase(database) +XrmDestroyDatabase(IN_OUT database) XrmDatabase database + CODE: + XrmDestroyDatabase( database ); + database = NULL; void XrmSetDatabase( display, database) From d50315dc53ffd6e407bdda2707fd129e45926103 Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Mon, 16 Aug 2021 11:59:04 -0400 Subject: [PATCH 3/6] make work on 5.8.9 --- Xlib.xs | 3 +-- t/50-resources.t | 2 -- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/Xlib.xs b/Xlib.xs index 1cf9071..c2a7afd 100644 --- a/Xlib.xs +++ b/Xlib.xs @@ -1653,8 +1653,7 @@ XrmLocaleOfDatabase(database) XrmDatabase database void -XrmDestroyDatabase(IN_OUT database) - XrmDatabase database +XrmDestroyDatabase(IN_OUT XrmDatabase database) CODE: XrmDestroyDatabase( database ); database = NULL; diff --git a/t/50-resources.t b/t/50-resources.t index 6f06f86..ceaf64f 100644 --- a/t/50-resources.t +++ b/t/50-resources.t @@ -1,7 +1,5 @@ #! /usr/bin/env perl -use v5.10; - use strict; use warnings; From defd28314d193525f30dab893d74ae79e2feab6c Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Tue, 17 Aug 2021 12:29:28 -0400 Subject: [PATCH 4/6] remove Xrm prefix from OO methods; improve OO documentation --- lib/X11/Xlib.pm | 6 +- lib/X11/Xlib/XrmDatabase.pm | 119 ++++++++++++++++++++++++++++++------ t/50-resources.t | 10 +-- 3 files changed, 110 insertions(+), 25 deletions(-) diff --git a/lib/X11/Xlib.pm b/lib/X11/Xlib.pm index ef7b2bc..edc4e5d 100644 --- a/lib/X11/Xlib.pm +++ b/lib/X11/Xlib.pm @@ -1473,7 +1473,7 @@ Retrieve a resource with the given C<$name> and C<$class>. C<$bool> is true if the resource was found. If C<$type> is C, C<$value> contains a string. Otherwise, it is up to the user to decode it, -=head3 XrmPutResource( IN_OUT XrmDatabaseMaybe database, specifier, type, value ) +=head3 XrmPutResource( XrmDatabaseMaybe database, specifier, type, value ) XrmPutResource( $database, $specifier, $type, $value ); @@ -1483,7 +1483,7 @@ the handle stored in C<$database>. If C<$type> is C, the C<$value> is assumed to be a Perl string and will be stored as a string, otherwise it is stored as is. -=head3 XrmPutStringResource( IN_OUT XrmDatabaseMaybe database, specifier, value ) +=head3 XrmPutStringResource( XrmDatabaseMaybe database, specifier, value ) XrmPutStringResource( $database, $specifier, $value ); @@ -1491,7 +1491,7 @@ Store the resource as a string the specified database. If C<$database> is C or not an existing database, a new one will be created and the handle stored in C<$database>. -=head3 XrmPutLineResource( IN_OUT XrmDatabaseMaybe database, line ) +=head3 XrmPutLineResource( XrmDatabaseMaybe database, line ) XrmPutLineResource( $database, $line ); diff --git a/lib/X11/Xlib/XrmDatabase.pm b/lib/X11/Xlib/XrmDatabase.pm index 47f1d38..3a1d86c 100644 --- a/lib/X11/Xlib/XrmDatabase.pm +++ b/lib/X11/Xlib/XrmDatabase.pm @@ -8,36 +8,121 @@ use X11::Xlib; # All modules in dist share a version our $VERSION = '0.20'; -*XrmPutFileDatabase = \&X11::Xlib::XrmPutFileDatabase; -*XrmLocaleOfDatabase = \&X11::Xlib::XrmLocaleOfDatabase; -*XrmDestroyDatabase = \&X11::Xlib::XrmDestroyDatabase; -*XrmCombineDatabase = \&X11::Xlib::XrmCombineDatabase; -*XrmMergeDatabases = \&X11::Xlib::XrmMergeDatabases; -*XrmGetResource = \&X11::Xlib::XrmGetResource; -*XrmPutResource = \&X11::Xlib::XrmPutResource; -*XrmPutStringResource = \&X11::Xlib::XrmPutStringResource; -*XrmPutLineResource = \&X11::Xlib::XrmPutLineResource; +# these are in the order they appear in the Xlib.xs file to make it +# easier to check for completeness. + +sub GetFileDatabase { + my ( $class, $file ) = @_; + X11::Xlib::XrmGetFileDatabase( $filename ); +}; + +*PutFileDatabase = \&X11::Xlib::XrmPutFileDatabase; + +# XResourceManagerString: unimplemented +# XScreenResourceString: unimplemented + +sub GetStringDatabase { + my ( $class, $string ) = @_; + X11::Xlib::XrmGetStringDatabase( $string ); +} + +*LocaleOfDatabase = \&X11::Xlib::XrmLocaleOfDatabase; + +*DestroyDatabase = \&X11::Xlib::XrmDestroyDatabase; + +# XrmSetDatabase: unimplemented +# XrmGetDatabase: unimplemented +# XrmCombineFileDatabase: unimplemented + +*CombineDatabase = \&X11::Xlib::XrmCombineDatabase; + +*MergeDatabases = \&X11::Xlib::XrmMergeDatabases; + +*GetResource = \&X11::Xlib::XrmGetResource; + +*PutResource = \&X11::Xlib::XrmPutResource; + +*PutStringResource = \&X11::Xlib::XrmPutStringResource; + +*PutLineResource = \&X11::Xlib::XrmPutLineResource; 1; =head1 NAME -X11::Xlib::XrmDatabase - Shadow class for X Resource Manager databases - +X11::Xlib::XrmDatabase - Object-Oriented Convenience Class for X Resource Manager Databases. =head1 SYNOPSIS -To make the methods available: - use X11::Xlib::XrmDatabase; -Otherwise, they are as available as functions when using L. + $db = X11::Xlib::XrmDatabase->GetFileDatabase( $file ); + $db = X11::Xlib::XrmDatabase->GetStringDatabase( $string ); =head1 DESCRIPTION -See L for more details. Any C -function whose first parameter is an X Resource database handle can be -used as a method after importing this module. +This module provides some object-oriented support for X Resource +Manager Databases. The method name is derived from the function name +by removing the C prefix, e.g. if the function name is + + XrmGetFileDatabase + +the associated method will be + + GetFileDatabase + +Not all of the Resource Manager functionality is exposed here. + +For more information see L. + +=head1 CONSTRUCTORS + +=head2 GetFileDatabase + + $db = X11::Xlib::XrmDatabase->GetFileDatabase( $file ); + +=head2 GetStringDatabase + + $db = X11::Xlib::XrmDatabase->GetStringDatabase( $string ); + +=head1 METHODS + +=head2 PutFileDatabase + + $db->PutFileDatabase( $filename ); + +=head2 LocaleOfDatabse + + $string = $db->LocaleOfDatabase; + +=head2 DestroyDatabase + + $db->DestroyDatabase + +=head2 CombineDatabase + + $db->CombineDatabase( $target_db, $override ); + +=head2 MergeDatabases + + $db->MergeDatabases( $target_db ); + +=head2 GetResource + + ($bool, $type, $value ) = $db->GetResource( $name, $class ); + +=head2 PutResource + + $db->PutResource( $specifier, $type, $value ); + +=head2 PutStringResource + + $db->PutStringResource( $specifier, $value ); + +=head2 PutLineResource + + $db->PutLineResource( $line ); + =head1 AUTHOR diff --git a/t/50-resources.t b/t/50-resources.t index ceaf64f..c4385fc 100644 --- a/t/50-resources.t +++ b/t/50-resources.t @@ -29,7 +29,7 @@ XrmInitialize(); sub test_db { my $db = shift; - my ( $bool, $type, $value ) = $db->XrmGetResource( + my ( $bool, $type, $value ) = $db->GetResource( 'xmh.toc.messagefunctions.incorporate.activeForeground', 'Xmh.Paned.Box.Command.Foreground' ); @@ -79,7 +79,7 @@ subtest PutFileDatabase => sub { my $db = XrmGetStringDatabase( $StringDB ); in_tempdir "method" => sub { - $db->XrmPutFileDatabase( "resources" ); + $db->PutFileDatabase( "resources" ); my $ndb = XrmGetFileDatabase( "resources" ); test_db( $ndb ); }; @@ -92,7 +92,7 @@ subtest CombineFileDatabase => sub { subtest methods => sub { in_tempdir "PutFile" => sub { my $source_db = XrmGetStringDatabase( $HALF1 ); - $source_db->XrmPutFileDatabase( $filename ); + $source_db->PutFileDatabase( $filename ); my $target_db = XrmGetStringDatabase( $HALF2 ); my $ok = XrmCombineFileDatabase( $filename, $target_db, 1 ); ok( $ok, 'XrmCombineFileDatabase' ); @@ -107,7 +107,7 @@ subtest CombineDatabase => sub { subtest methods => sub { my $source_db = XrmGetStringDatabase( $HALF1 ); my $target_db = XrmGetStringDatabase( $HALF2 ); - $source_db->XrmCombineDatabase( $target_db, 1 ); + $source_db->CombineDatabase( $target_db, 1 ); test_db( $target_db ); }; @@ -118,7 +118,7 @@ subtest MergeDatabases => sub { subtest methods => sub { my $source_db = XrmGetStringDatabase( $HALF1 ); my $target_db = XrmGetStringDatabase( $HALF2 ); - $source_db->XrmMergeDatabases( $target_db ); + $source_db->MergeDatabases( $target_db ); test_db( $target_db ); }; From f656f964c0cfbb1262ae9da63e4205841dabfa9d Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Tue, 17 Aug 2021 12:34:18 -0400 Subject: [PATCH 5/6] fix typo in parameter name --- lib/X11/Xlib/XrmDatabase.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/X11/Xlib/XrmDatabase.pm b/lib/X11/Xlib/XrmDatabase.pm index 3a1d86c..9ea636f 100644 --- a/lib/X11/Xlib/XrmDatabase.pm +++ b/lib/X11/Xlib/XrmDatabase.pm @@ -12,7 +12,7 @@ our $VERSION = '0.20'; # easier to check for completeness. sub GetFileDatabase { - my ( $class, $file ) = @_; + my ( $class, $filename ) = @_; X11::Xlib::XrmGetFileDatabase( $filename ); }; From a91bc95d540660b000151698b612ec705ec1a22f Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Tue, 17 Aug 2021 14:15:58 -0400 Subject: [PATCH 6/6] code tidy; remove unneeded extra layer in some subtests --- t/50-resources.t | 48 ++++++++++++++++++++---------------------------- typemap | 1 - 2 files changed, 20 insertions(+), 29 deletions(-) diff --git a/t/50-resources.t b/t/50-resources.t index c4385fc..ca7e7fa 100644 --- a/t/50-resources.t +++ b/t/50-resources.t @@ -22,17 +22,15 @@ END my $StringDB = $HALF1 . $HALF2; - - XrmInitialize(); sub test_db { my $db = shift; - my ( $bool, $type, $value ) = $db->GetResource( + my ( $bool, $type, $value ) + = $db->GetResource( 'xmh.toc.messagefunctions.incorporate.activeForeground', - 'Xmh.Paned.Box.Command.Foreground' - ); + 'Xmh.Paned.Box.Command.Foreground' ); is( !!$bool, 1, 'success' ); is( $type, 'String', 'type' ); @@ -44,7 +42,7 @@ subtest 'File' => sub { }; subtest String => sub { - test_db( XrmGetStringDatabase( $StringDB ) ) + test_db( XrmGetStringDatabase( $StringDB ) ); }; sub Put { @@ -68,7 +66,7 @@ subtest Put => sub { }; subtest PutString => sub { - test_put sub { XrmPutStringResource(@_) }; + test_put sub { XrmPutStringResource( @_ ) }; }; subtest PutLine => sub { @@ -89,38 +87,32 @@ subtest PutFileDatabase => sub { subtest CombineFileDatabase => sub { my $filename = 'resources'; - subtest methods => sub { - in_tempdir "PutFile" => sub { - my $source_db = XrmGetStringDatabase( $HALF1 ); - $source_db->PutFileDatabase( $filename ); - my $target_db = XrmGetStringDatabase( $HALF2 ); - my $ok = XrmCombineFileDatabase( $filename, $target_db, 1 ); - ok( $ok, 'XrmCombineFileDatabase' ); - test_db( $target_db ); - }; + in_tempdir "PutFile" => sub { + my $source_db = XrmGetStringDatabase( $HALF1 ); + $source_db->PutFileDatabase( $filename ); + my $target_db = XrmGetStringDatabase( $HALF2 ); + my $ok = XrmCombineFileDatabase( $filename, $target_db, 1 ); + ok( $ok, 'XrmCombineFileDatabase' ); + test_db( $target_db ); }; }; subtest CombineDatabase => sub { - subtest methods => sub { - my $source_db = XrmGetStringDatabase( $HALF1 ); - my $target_db = XrmGetStringDatabase( $HALF2 ); - $source_db->CombineDatabase( $target_db, 1 ); - test_db( $target_db ); - }; + my $source_db = XrmGetStringDatabase( $HALF1 ); + my $target_db = XrmGetStringDatabase( $HALF2 ); + $source_db->CombineDatabase( $target_db, 1 ); + test_db( $target_db ); }; subtest MergeDatabases => sub { - subtest methods => sub { - my $source_db = XrmGetStringDatabase( $HALF1 ); - my $target_db = XrmGetStringDatabase( $HALF2 ); - $source_db->MergeDatabases( $target_db ); - test_db( $target_db ); - }; + my $source_db = XrmGetStringDatabase( $HALF1 ); + my $target_db = XrmGetStringDatabase( $HALF2 ); + $source_db->MergeDatabases( $target_db ); + test_db( $target_db ); }; diff --git a/typemap b/typemap index 63d28a8..0b28cd7 100644 --- a/typemap +++ b/typemap @@ -150,7 +150,6 @@ T_PTROBJ_SPECIAL else sv_setref_pv($arg, \"X11::Xlib::${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\", (void*)$var); - INPUT T_PTROBJ_SPECIAL_Maybe if (sv_isobject($arg) && sv_derived_from($arg, \"X11::Xlib::${(my $ntt=$ntype)=~s/_/::/g; $ntt =~ s/Maybe$//;\$ntt}\")){