packages feed

xfconf (empty) → 4.8.0.0

raw patch · 30 files changed

+4636/−0 lines, 30 filesdep +HUnitdep +QuickCheckdep +basebuild-type:Customsetup-changed

Dependencies added: HUnit, QuickCheck, base, glib, test-framework, test-framework-hunit, test-framework-quickcheck2

Files

+ C/Makefile view
@@ -0,0 +1,15 @@+XFFLAGS  = `pkg-config --libs --cflags libxfconf-0`+CFLAGS   = -Wall -Wextra -ansi -pedantic -g $(XFFLAGS) \+ 		   -Wno-missing-field-initializers -Wno-unused-variable+SRCS     = demo.c+BINARIES = $(SRCS:.c=)++all: $(BINARIES)++%.o: %.c+	$(CC) $(CFLAGS) -c $^++clean:+	-@ rm $(BINARIES)++.PHONY: clean all
+ C/demo.c view
@@ -0,0 +1,367 @@+/*+ * vim:ts=4:sw=4:+ */+#include <xfce4/xfconf-0/xfconf/xfconf.h>+#include <stdio.h>+#include <stdlib.h>++/* from xfconf/common/xfconf-common-private.h */+#include <dbus/dbus-glib.h>+#define XFCONF_TYPE_G_VALUE_ARRAY  (dbus_g_type_get_collection("GPtrArray", G_TYPE_VALUE))++void+print_channels (void) {+	gchar **channels = NULL;+	gint i;++	channels = xfconf_list_channels ();+	for (i = 0; channels[i]; i++) {+		g_print ("found channel [%s]\n", channels[i]);+	}+	g_strfreev (channels);+}++void+play_with_string (XfconfChannel *chan) {+	const gchar *prop = "/String";+	gchar *value;+	value = xfconf_channel_get_string (chan, prop, "NA");+	g_print ("%s is [%s]\n", prop, value);+	g_free (value);++	if (!xfconf_channel_set_string (chan, prop, "HelloWorld")) {+		g_printerr ("ERROR: cannot set xfwm4 theme :(\n");+	} else {+		g_print ("Successfully tweak xfwm4 theme\n");+	}+}++void+play_with_double (XfconfChannel *chan) {+	const gchar *prop = "/Double";+	gdouble value;+	value = xfconf_channel_get_double (chan, prop, 0.0);+	g_print ("%s is [%f]\n", prop, value);++	if (!xfconf_channel_set_double (chan, prop, 3.3)) {+		g_printerr ("ERROR: cannot set saturation :(\n");+	} else {+		g_print ("Successfully tweak saturation\n");+	}+}+++/* You can see in the following code that even if we set gvalues+ * with xfconf_g_value_set_uint16, when we get them back from the+ * xfconfd store, they are UINT and not uint16.+ *+ * ... this close our pseudo haskell bug :)+ */+void+play_with_uint16 (XfconfChannel* chan) {+	const gchar *prop = "/UInt16";+	GValue value = {0};++	g_value_init(&value, XFCONF_TYPE_UINT16);+	xfconf_g_value_set_uint16 (&value, 33);+	if (!xfconf_channel_set_property (chan, prop, &value))+		g_error ("cannot set uint16 value to 33\n");++	g_value_unset(&value);+	if (xfconf_channel_get_property (chan, prop, &value)) {+		if (G_VALUE_HOLDS (&value, XFCONF_TYPE_UINT16)) {+			guint16 x = xfconf_g_value_get_uint16 (&value);+			g_print ("%s is an uint16: %u\n", prop, x);+		} else if (G_VALUE_HOLDS (&value,G_TYPE_UINT)) {+			guint x = g_value_get_uint (&value);+			g_print ("%s is an uint: %u\n", prop, x);+		} else {+			g_error ("Unknown GValue type for our uint16\n");+		}+	} else {+		g_error ("Cannot get UInt16 GValue !\n");+	}+}++/* rinse and repeat */+void+play_with_int16 (XfconfChannel* chan) {+	const gchar *prop = "/Int16";+	GValue value = {0};++	g_value_init(&value, XFCONF_TYPE_INT16);+	xfconf_g_value_set_int16 (&value, -33);+	if (!xfconf_channel_set_property (chan, prop, &value))+		g_error ("cannot set int16 value to -33\n");++	g_value_unset(&value);+	if (xfconf_channel_get_property (chan, prop, &value)) {+		if (G_VALUE_HOLDS (&value, XFCONF_TYPE_INT16)) {+			gint16 x = xfconf_g_value_get_int16 (&value);+			g_print ("%s is an int16: %d\n", prop, x);+		} else if (G_VALUE_HOLDS (&value,G_TYPE_INT)) {+			gint x = g_value_get_int (&value);+			g_print ("%s is an int: %d\n", prop, x);+		} else {+			g_error ("Unknown GValue type for our int16\n");+		}+	} else {+		g_error ("Cannot get Int16 GValue !\n");+	}+}++GPtrArray *free_my_array (GPtrArray* array) {+	unsigned int i;++	if (!array)+		return NULL;++	for(i = 0; i < array->len; i++) {+		GValue *gvalue = g_ptr_array_index(array, 0);+		g_free(gvalue);+	}++	g_ptr_array_free(array, TRUE);++	return NULL;+}++/* Does xfconfd free itself old arrays ??? */+void+play_with_arrays (XfconfChannel* chan) {+	const gchar *prop = "/Array";+	GValue *element0 = g_new0(GValue, 1);+	GValue *element1 = g_new0(GValue, 1);+	GPtrArray *array0 = g_ptr_array_sized_new(1);+	GPtrArray *array1 = g_ptr_array_sized_new(1);+	GValue box0 = {0};+	GValue box1 = {0};++	/* Set array value, first version */+	g_value_init(element0, G_TYPE_STRING);+	g_value_set_string(element0, "first item");+	g_ptr_array_add(array0, element0);+	g_value_init(&box0, XFCONF_TYPE_G_VALUE_ARRAY);+	g_value_set_boxed(&box0, array0);+	if (!xfconf_channel_set_property(chan, prop, &box0))+		g_error("fail to set array0\n");++	g_print("array0.len = %d\n", array0->len);+	g_print("array1.len = %d\n", array1->len);++	puts("Press any key to continue");+	getc(stdin);++	/* Set array value, second version */+	g_value_init(element1, G_TYPE_STRING);+	g_value_set_string(element1, "second item");+	g_ptr_array_add(array1, element1);+	g_value_init(&box1, XFCONF_TYPE_G_VALUE_ARRAY);+	g_value_set_boxed(&box1, array1);+	if (!xfconf_channel_set_property(chan, prop, &box1))+		g_error("fail to set array1\n");++	array0 = free_my_array (array0);+	array1 = free_my_array (array1);++	if (array0) {+		GValue *element = g_ptr_array_index(array0, 0);+		if (element)+			g_print("array0[0] = %s\n", g_value_get_string(element));+	}++	g_print("array0.len = %d\n", array0 ? array0->len : 0);+	g_print("array1.len = %d\n", array1 ? array1->len : 0);++	g_print("conclusion: there is a memory leak when setting new arrays\n");++}++void+print_keys (gpointer data, gpointer user_data) {+	gchar *key = data;+	if (user_data != NULL) {+		g_error ("have you forgotten to set user_data to NULL ?\n");+		return;+	} else {+		g_print ("found %s\n", key);+	}+}++void+strings_array_print_string(gchar ** strings)+{+	int i;++	if (strings == NULL) {+		g_printerr("string array is NULL !\n");+		return;+	}++	for (i = 0; ; i++) {+		gchar *s = strings[i];+		if (s == NULL) break;+		g_print("strings2[%d] = %s\n", i, s);+	}+}++/* Where you can admire the use of GOTOs and why xfconf string list are+ * just another type of GPtrArray*+ */+void+play_with_string_list (XfconfChannel *chan) {+	GHashTable* table = xfconf_channel_get_properties (chan,"/");+	GList* list = g_hash_table_get_keys(table);+	GValue* value;++	g_list_foreach (list, &print_keys, NULL);++	value = g_hash_table_lookup(table, "/Int");+	if (value == NULL) {+		g_error("GValue is void, aborting ...\n");+		goto EXIT_STRING_LIST;+	}++	g_print ("/Int is %d\n", g_value_get_int(value));++    g_print ("/Int has type [%s]\n", G_VALUE_TYPE_NAME(value));++    value = g_hash_table_lookup(table, "/StringList");+    g_print ("/StringList is [%s]\n", G_VALUE_TYPE_NAME(value));+    g_print ("/StringList type id is [%u]\n", (guint)G_VALUE_TYPE(value));+	if (G_VALUE_TYPE(value) == XFCONF_TYPE_G_VALUE_ARRAY)+		g_print ("Yes, it is an (xfconf) array\n");+	else+		g_print("No, it is not an array, since arrays have type [%u]\n", (guint)G_TYPE_VALUE_ARRAY);++EXIT_STRING_LIST:+	g_list_free(list);+	g_hash_table_destroy(table);+}++/* Silly programmers WILL try to set string lists to an empty array.+ *+ * A bug in the Haskell xfconf appears when:+ * 0) a string list property is intialized to some non-empty array;+ * 1) the same property is then set to an empty array (via+ * set_string_list or reset_property);+ * 2) but the proprety ain't empty, it still holds the previous content.+ *+ * This function checks in C that xfconf_channel_reset_property+ * correctly set an empty array.+ */+void+play_with_null_string_list (XfconfChannel *chan) {+	const gchar prop[20] = "/StringList";+	const gchar * const strings[] = { "one", "two", "three", NULL };+	const gchar * const strings0[] = { NULL };+	gchar **strings2 = NULL;+	int ret;++	g_print("Setting string array to:\n");+	strings_array_print_string((gchar **)strings);++	ret = xfconf_channel_set_string_list(chan, prop, strings);+	if (ret == FALSE) {+		g_print("Cannot set string array !\n");+	}++	g_print("Array retrieved is now:\n");+	strings2 = xfconf_channel_get_string_list(chan, prop);+	strings_array_print_string(strings2);+	g_strfreev(strings2);+	strings2 = NULL;++	g_print("And now for something completely different ...\n");+	g_print("... setting the property to an empty array !\n");+	xfconf_channel_reset_property(chan, prop, FALSE);++	g_print("retreived array is:\n");+	strings2 = xfconf_channel_get_string_list(chan, prop);+	strings_array_print_string(strings2);++	ret = xfconf_channel_set_string_list(chan, prop, strings0);+	if (ret == FALSE) {+		g_print("Cannot set NULL string array !\n");+	}++	ret = xfconf_channel_set_string_list(chan, prop, NULL);+	if (ret == FALSE) {+		g_print("Cannot set NULL string array !\n");+	}+}++/* when xfconf_channel_get_property returns false, the GValue* is+ * uninitialized and we cannot unset it safely */+void+play_with_gvalue_bug (XfconfChannel* chan) {+	GValue gvalue = {0};+	const gchar* prop = "/notExisitingProperty";++	xfconf_channel_get_property (chan, prop, &gvalue);++	if (G_IS_VALUE(&gvalue))+		g_print ("I've got a valid value !\n");+	else+		g_print ("unvalid gvalue !\n");+}++int+main (void) {+	GError *error = NULL;+	const gchar name[20] = "quickcheck";++	/* init */+	xfconf_init (&error);+	if (error != NULL) {+		g_printerr( "an error with code %d occured: %s\n",+				error->code, error->message);+		g_clear_error (&error);+		return EXIT_FAILURE;+	}+	else+		printf ("Hello world of xfconf !\n");++	/* list channels */+	/*print_channels ();*/++	/* play with values get/set */+	{+		XfconfChannel *chan = xfconf_channel_get (name);++		if (chan == NULL) {+			g_critical("Failed to connect to \"%s\" channel\n", name);+			return EXIT_FAILURE;+		}++		/* string */+		/*play_with_string (chan);*/++		/* double */+		/*play_with_double (chan);*/++		/* uint16 */+		/*play_with_uint16 (chan);*/++		/* uint16 */+		/*play_with_int16 (chan);*/++		/* StringList */+		/*play_with_string_list (chan);*/++		/* Array */+		/*play_with_arrays (chan);*/++		/* GValue bug */+		/*play_with_gvalue_bug (chan);*/++		/* Empty string array. */+		play_with_null_string_list (chan);+	}++	xfconf_shutdown ();+	return EXIT_SUCCESS;+}+/*+ * vim:tabstop=4:+ */
+ Demo/Demo.hs view
@@ -0,0 +1,102 @@+-- A simple demo program for xfconf.+-- Required gtk >= 0.12.+--+module Main where++import Control.Monad      (forM_)++import Graphics.UI.Gtk++import System.XFCE.Xfconf++main :: IO ()+main = createWindow++createWindow :: IO ()+createWindow = do+        -- normally returns the remaining command line arguments+        initGUI++        -- Our special xfconf channel+        chan <- channelGet "Demo"++        -- Create window and main container+        window <- windowNew+        grid   <- tableNew 4 3 False -- rows, columns, homogenous+        set grid   [ tableRowSpacing      := 10 ]+        set window [ windowTitle          := "Xfconf Binding demo"+                   , containerBorderWidth := 10+                   , containerChild       := grid ]+        onDestroy window $ do+                mainQuit+                putStrLn "ByeBye"++        -- * Create container content+        -- ** First line: instruction+        instruction <- labelNew (Just+          "This window demonstrates the binding between Gtk\+          \ CheckButtons, the xfconf backend and Gtk Labels. Every time\+          \ you (un)check one of the button, xfconf is updated\+          \ accordingly and its state is mirrored in both the label and\+          \ the other button.")+        labelSetJustify instruction JustifyCenter+        set instruction [ labelWrap           := True+                        , labelWidthChars     := 80+                        , labelSingleLineMode := False ]+        tableAttachDefaults grid instruction 0 3 0 1++        -- ** Second line: titles+        title0 <- labelNew (Just "<b>Ur button</b>")+        title1 <- labelNew (Just "<b>Xfconf value</b>")+        title2 <- labelNew (Just "<b>Mirror button</b>")+        forM_ [(title0,0,1), (title1,1,2), (title2,2,3)] $ \(w,l,r) -> do+                labelSetUseMarkup w True+                tableAttachDefaults grid w l r 1 2++        -- ** Third line: check/label+        check0 <- checkButtonNewWithLabel "Check me !"+        label0 <- labelNew (Just "<null>")+        check1 <- checkButtonNewWithLabel "Check me !"+        tableAttachDefaults grid check0 0 1 2 3+        tableAttachDefaults grid label0 1 2 2 3+        tableAttachDefaults grid check1 2 3 2 3+        set grid [ tableChildXOptions check0 := []+                 , tableChildXOptions label0 := []+                 , tableChildXOptions check1 := [] ]++        -- Signals voodoo \o/+        -- * xfconf binding+        xfsig0 <- xfconfBind chan "/check" bool check0 "active"+        xfsig1 <- xfconfBind chan "/check" bool check1 "active"+        -- * xfconf monitoring+        onPropertyChanged chan $ \key maybeValue -> do+          if key /= "/check"+           then return ()+           else case maybeValue of+             Just (XfconfBool True) -> labelSetText label0 "checked !"+             Just (XfconfBool False) -> labelSetText label0 "unchecked !"+             _ -> labelSetText label0 "UNKNOWN"+++        -- ** Fourth line: test unbind(s)+        breakMe0 <- buttonNewWithLabel "Unbind"+        breakMe1 <- buttonNewWithLabel "Unbind all"+        breakMe2 <- buttonNewWithLabel "Unbind property"+        tableAttachDefaults grid breakMe0 0 1 3 4+        tableAttachDefaults grid breakMe1 1 2 3 4+        tableAttachDefaults grid breakMe2 2 3 3 4+        onClicked breakMe0 $ do+                xfconfUnbind xfsig0+                xfconfUnbind xfsig1+        onClicked breakMe1 $ do+                xfconfUnbindAll check0+                xfconfUnbindAll chan+        onClicked breakMe2 $ do+                xfconfUnbindByProperty chan "/check" check0 "active"+                xfconfUnbindByProperty chan "/check" check1 "active"++        -- END+        widgetShowAll window++        mainGUI+
+ Gtk2HsSetup.hs view
@@ -0,0 +1,511 @@+{-# LANGUAGE CPP #-}++#define CABAL_VERSION_ENCODE(major, minor, micro) (     \+          ((major) * 10000)                             \+        + ((minor) *   100)                             \+        + ((micro) *     1))++#define CABAL_VERSION_CHECK(major,minor,micro)    \+        (CABAL_VERSION >= CABAL_VERSION_ENCODE(major,minor,micro))++-- now, this is bad, but Cabal doesn't seem to actually pass any information about+-- its version to CPP, so guess the version depending on the version of GHC+#ifdef CABAL_VERSION_MINOR+#ifndef CABAL_VERSION_MAJOR+#define CABAL_VERSION_MAJOR 1+#endif+#ifndef CABAL_VERSION_MICRO+#define CABAL_VERSION_MICRO 0+#endif+#define CABAL_VERSION CABAL_VERSION_ENCODE(     \+        CABAL_VERSION_MAJOR,                    \+        CABAL_VERSION_MINOR,                    \+        CABAL_VERSION_MICRO)+#else+#warning Setup.hs is guessing the version of Cabal. If compilation of Setup.hs fails use -DCABAL_VERSION_MINOR=x for Cabal version 1.x.0 when building (prefixed by --ghc-option= when using the 'cabal' command)+#if (__GLASGOW_HASKELL__ >= 700)+#define CABAL_VERSION CABAL_VERSION_ENCODE(1,10,0)+#else+#if (__GLASGOW_HASKELL__ >= 612)+#define CABAL_VERSION CABAL_VERSION_ENCODE(1,8,0)+#else+#define CABAL_VERSION CABAL_VERSION_ENCODE(1,6,0)+#endif+#endif+#endif++-- | Build a Gtk2hs package.+--+module Gtk2HsSetup ( +  gtk2hsUserHooks, +  getPkgConfigPackages, +  checkGtk2hsBuildtools+  ) where++import Distribution.Simple+import Distribution.Simple.PreProcess+import Distribution.InstalledPackageInfo ( importDirs,+                                           showInstalledPackageInfo,+                                           libraryDirs,+                                           extraLibraries,+                                           extraGHCiLibraries )+import Distribution.Simple.PackageIndex (+#if CABAL_VERSION_CHECK(1,8,0)+  lookupInstalledPackageId+#else+  lookupPackageId+#endif+  )+import Distribution.PackageDescription as PD ( PackageDescription(..),+                                               updatePackageDescription,+                                               BuildInfo(..),+                                               emptyBuildInfo, allBuildInfo,+                                               Library(..),+                                               libModules, hasLibs)+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..),+                                           InstallDirs(..),+#if CABAL_VERSION_CHECK(1,8,0)+                                           componentPackageDeps,+#else+                                           packageDeps,+#endif+                                           absoluteInstallDirs)+import Distribution.Simple.Compiler  ( Compiler(..) )+import Distribution.Simple.Program (+  Program(..), ConfiguredProgram(..),+  rawSystemProgramConf, rawSystemProgramStdoutConf, programName,+  c2hsProgram, pkgConfigProgram, requireProgram, ghcPkgProgram,+  simpleProgram, lookupProgram, rawSystemProgramStdout, ProgArg)+import Distribution.ModuleName ( ModuleName, components, toFilePath )+import Distribution.Simple.Utils+import Distribution.Simple.Setup (CopyFlags(..), InstallFlags(..), CopyDest(..),+                                  defaultCopyFlags, ConfigFlags(configVerbosity),+                                  fromFlag, toFlag, RegisterFlags(..), flagToMaybe,+                                  fromFlagOrDefault, defaultRegisterFlags)+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Install ( install )+#if CABAL_VERSION_CHECK(1,8,0)+import Distribution.Simple.Register ( generateRegistrationInfo, registerPackage )+#else+import qualified Distribution.Simple.Register as Register ( register )+#endif+import Distribution.Text ( simpleParse, display )+import System.FilePath+import System.Exit (exitFailure)+import System.Directory ( doesFileExist, getDirectoryContents, doesDirectoryExist )+import Distribution.Version (Version(..))+import Distribution.Verbosity+import Control.Monad (when, unless, filterM, liftM, forM, forM_)+import Data.Maybe ( isJust, isNothing, fromMaybe, maybeToList )+import Data.List (isPrefixOf, isSuffixOf, nub)+import Data.Char (isAlpha)+import qualified Data.Map as M+import qualified Data.Set as S++import Control.Applicative ((<$>))++-- the name of the c2hs pre-compiled header file+precompFile = "precompchs.bin"++gtk2hsUserHooks = simpleUserHooks {+    hookedPrograms = [typeGenProgram, signalGenProgram, c2hsLocal],+    hookedPreProcessors = [("chs", ourC2hs)],+    confHook = \pd cf ->+      (fmap adjustLocalBuildInfo (confHook simpleUserHooks pd cf)),+    postConf = \args cf pd lbi -> do+      genSynthezisedFiles (fromFlag (configVerbosity cf)) pd lbi+      postConf simpleUserHooks args cf pd lbi,+    buildHook = \pd lbi uh bf -> fixDeps pd >>= \pd ->+                                 buildHook simpleUserHooks pd lbi uh bf,+    copyHook = \pd lbi uh flags -> copyHook simpleUserHooks pd lbi uh flags >>+      installCHI pd lbi (fromFlag (copyVerbosity flags)) (fromFlag (copyDest flags)),+    instHook = \pd lbi uh flags ->+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+      installHook pd lbi uh flags >>+      installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest,+    regHook = registerHook+#else+      instHook simpleUserHooks pd lbi uh flags >>+      installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest+#endif+  }++------------------------------------------------------------------------------+-- Lots of stuff for windows ghci support+------------------------------------------------------------------------------++getDlls :: [FilePath] -> IO [FilePath]+getDlls dirs = filter ((== ".dll") . takeExtension) . concat <$>+    mapM getDirectoryContents dirs++fixLibs :: [FilePath] -> [String] -> [String]+fixLibs dlls = concatMap $ \ lib ->+    case filter (("lib" ++ lib) `isPrefixOf`) dlls of+                dll:_ -> [dropExtension dll]+                _     -> if lib == "z" then [] else [lib]++-- The following code is a big copy-and-paste job from the sources of+-- Cabal 1.8 just to be able to fix a field in the package file. Yuck.++#if CABAL_VERSION_CHECK(1,8,0)+        +installHook :: PackageDescription -> LocalBuildInfo+                   -> UserHooks -> InstallFlags -> IO ()+installHook pkg_descr localbuildinfo _ flags = do+  let copyFlags = defaultCopyFlags {+                      copyDistPref   = installDistPref flags,+                      copyDest       = toFlag NoCopyDest,+                      copyVerbosity  = installVerbosity flags+                  }+  install pkg_descr localbuildinfo copyFlags+  let registerFlags = defaultRegisterFlags {+                          regDistPref  = installDistPref flags,+                          regInPlace   = installInPlace flags,+                          regPackageDB = installPackageDB flags,+                          regVerbosity = installVerbosity flags+                      }+  when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo registerFlags++registerHook :: PackageDescription -> LocalBuildInfo+        -> UserHooks -> RegisterFlags -> IO ()+registerHook pkg_descr localbuildinfo _ flags =+    if hasLibs pkg_descr+    then register pkg_descr localbuildinfo flags+    else setupMessage verbosity+           "Package contains no library to register:" (packageId pkg_descr)+  where verbosity = fromFlag (regVerbosity flags)++register :: PackageDescription -> LocalBuildInfo+         -> RegisterFlags -- ^Install in the user's database?; verbose+         -> IO ()+register pkg@PackageDescription { library       = Just lib  }+         lbi@LocalBuildInfo     { libraryConfig = Just clbi } regFlags+  = do++    installedPkgInfoRaw <- generateRegistrationInfo+                           verbosity pkg lib lbi clbi inplace distPref++    dllsInScope <- getSearchPath >>= (filterM doesDirectoryExist) >>= getDlls+    let libs = fixLibs dllsInScope (extraLibraries installedPkgInfoRaw)+        installedPkgInfo = installedPkgInfoRaw {+                                extraGHCiLibraries = libs }++     -- Three different modes:+    case () of+     _ | modeGenerateRegFile   -> die "Generate Reg File not supported"+       | modeGenerateRegScript -> die "Generate Reg Script not supported"+       | otherwise             -> registerPackage verbosity+#if CABAL_VERSION_CHECK(1,10,0)+                                    installedPkgInfo pkg lbi inplace [packageDb]+#else+                                    installedPkgInfo pkg lbi inplace packageDb+#endif++  where+    modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags))+    modeGenerateRegScript = fromFlag (regGenScript regFlags)+    inplace   = fromFlag (regInPlace regFlags)+    packageDb = case flagToMaybe (regPackageDB regFlags) of+                    Just db -> db+                    Nothing -> registrationPackageDB (withPackageDB lbi)+    distPref  = fromFlag (regDistPref regFlags)+    verbosity = fromFlag (regVerbosity regFlags)++register _ _ regFlags = notice verbosity "No package to register"+  where+    verbosity = fromFlag (regVerbosity regFlags)++#else+installHook :: PackageDescription -> LocalBuildInfo+                   -> UserHooks -> InstallFlags -> IO ()+installHook pkg_descr localbuildinfo _ flags = do+  let copyFlags = defaultCopyFlags {+                      copyDistPref   = installDistPref flags,+                      copyInPlace    = installInPlace flags,+                      copyUseWrapper = installUseWrapper flags,+                      copyDest       = toFlag NoCopyDest,+                      copyVerbosity  = installVerbosity flags+                  }+  install pkg_descr localbuildinfo copyFlags+  let registerFlags = defaultRegisterFlags {+                          regDistPref  = installDistPref flags,+                          regInPlace   = installInPlace flags,+                          regPackageDB = installPackageDB flags,+                          regVerbosity = installVerbosity flags+                      }+  when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo registerFlags++registerHook :: PackageDescription -> LocalBuildInfo+        -> UserHooks -> RegisterFlags -> IO ()+registerHook pkg_descr localbuildinfo _ flags =+    if hasLibs pkg_descr+    then register pkg_descr localbuildinfo flags+    else setupMessage verbosity+           "Package contains no library to register:" (packageId pkg_descr)+  where verbosity = fromFlag (regVerbosity flags)++register :: PackageDescription -> LocalBuildInfo+         -> RegisterFlags -- ^Install in the user's database?; verbose+         -> IO ()+register pkg_descr lbi regFlags = do+  let verbosity = fromFlag (regVerbosity regFlags)+  warn verbosity "Cannot register ghci libraries with Cabal 1.6 (need 1.8)."+  Register.register pkg_descr lbi regFlags+  +#endif++------------------------------------------------------------------------------+-- This is a hack for Cabal-1.8, It is not needed in Cabal-1.9.1 or later+------------------------------------------------------------------------------++adjustLocalBuildInfo :: LocalBuildInfo -> LocalBuildInfo+adjustLocalBuildInfo lbi =+  let extra = (Just libBi, [])+      libBi = emptyBuildInfo { includeDirs = [ autogenModulesDir lbi+                                             , buildDir lbi ] }+   in lbi { localPkgDescr = updatePackageDescription extra (localPkgDescr lbi) }++------------------------------------------------------------------------------+-- Processing .chs files with our local c2hs.+------------------------------------------------------------------------------++ourC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor+ourC2hs bi lbi = PreProcessor {+  platformIndependent = False,+  runPreProcessor = runC2HS bi lbi+}++runC2HS :: BuildInfo -> LocalBuildInfo ->+           (FilePath, FilePath) -> (FilePath, FilePath) -> Verbosity -> IO ()+runC2HS bi lbi (inDir, inFile)  (outDir, outFile) verbosity = do+  -- have the header file name if we don't have the precompiled header yet+  header <- case lookup "x-c2hs-header" (customFieldsBI bi) of+    Just h -> return h+    Nothing -> die ("Need x-c2hs-Header definition in the .cabal Library section "+++                    "that sets the C header file to process .chs.pp files.")++  -- c2hs will output files in out dir, removing any leading path of the input file.+  -- Thus, append the dir of the input file to the output dir.+  let (outFileDir, newOutFile) = splitFileName outFile+  let newOutDir = outDir </> outFileDir+  -- additional .chi files might be needed that other packages have installed;+  -- we assume that these are installed in the same place as .hi files+  let chiDirs = [ dir |+#if CABAL_VERSION_CHECK(1,8,0)+                  ipi <- maybe [] (map fst . componentPackageDeps) (libraryConfig lbi),+                  dir <- maybe [] importDirs (lookupInstalledPackageId (installedPkgs lbi) ipi) ]+#else+                  ipi <- packageDeps lbi,+                  dir <- maybe [] importDirs (lookupPackageId (installedPkgs lbi) ipi) ]+#endif+  rawSystemProgramConf verbosity c2hsLocal (withPrograms lbi) $+       map ("--include=" ++) (outDir:chiDirs)+    ++ ["--cppopts=" ++ opt | opt <- getCppOptions bi lbi]+    ++ ["--output-dir=" ++ newOutDir,+        "--output=" ++ newOutFile,+        "--precomp=" ++ buildDir lbi </> precompFile,+        header, inDir </> inFile]++getCppOptions :: BuildInfo -> LocalBuildInfo -> [String]+getCppOptions bi lbi+    = nub $+      ["-I" ++ dir | dir <- PD.includeDirs bi]+   ++ [opt | opt@('-':c:_) <- PD.cppOptions bi ++ PD.ccOptions bi, c `elem` "DIU"]++installCHI :: PackageDescription -- ^information from the .cabal file+        -> LocalBuildInfo -- ^information from the configure step+        -> Verbosity -> CopyDest -- ^flags sent to copy or install+        -> IO ()+installCHI pkg@PD.PackageDescription { library = Just lib } lbi verbosity copydest = do+  let InstallDirs { libdir = libPref } = absoluteInstallDirs pkg lbi copydest+  -- cannot use the recommended 'findModuleFiles' since it fails if there exists+  -- a modules that does not have a .chi file+  mFiles <- mapM (findFileWithExtension' ["chi"] [buildDir lbi] . toFilePath)+#if CABAL_VERSION_CHECK(1,8,0)+                   (PD.libModules lib)+#else+                   (PD.libModules pkg)+#endif+                 +  let files = [ f | Just f <- mFiles ]+#if CABAL_VERSION_CHECK(1,8,0)+  installOrdinaryFiles verbosity libPref files+#else+  copyFiles verbosity libPref files+#endif++  +installCHI _ _ _ _ = return ()++------------------------------------------------------------------------------+-- Generating the type hierarchy and signal callback .hs files.+------------------------------------------------------------------------------++typeGenProgram :: Program+typeGenProgram = simpleProgram "gtk2hsTypeGen"++signalGenProgram :: Program+signalGenProgram = simpleProgram "gtk2hsHookGenerator"++c2hsLocal :: Program+c2hsLocal = simpleProgram "gtk2hsC2hs"++genSynthezisedFiles :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+genSynthezisedFiles verb pd lbi = do++  cPkgs <- getPkgConfigPackages verb lbi pd++  let xList = maybe [] (customFieldsBI . libBuildInfo) (library pd)+              ++customFieldsPD pd+      typeOpts :: String -> [ProgArg]+      typeOpts tag = concat [ map (\val -> '-':'-':drop (length tag) field++'=':val) (words content)+                            | (field,content) <- xList,+                              tag `isPrefixOf` field,+                              field /= (tag++"file")]+              ++ [ "--tag=" ++ tag+                 | PackageIdentifier name (Version (major:minor:_) _) <- cPkgs+                 , let name' = filter isAlpha (display name)+                 , tag <- name'+                        : [ name' ++ "-" ++ show major ++ "." ++ show digit+                          | digit <- [0,2..minor] ]+                 ]++      signalsOpts :: [ProgArg]+      signalsOpts = concat [ map (\val -> '-':'-':drop 10 field++'=':val) (words content)+                        | (field,content) <- xList,+                          "x-signals-" `isPrefixOf` field,+                          field /= "x-signals-file"]++      genFile :: Program -> [ProgArg] -> FilePath -> IO ()+      genFile prog args outFile = do+         res <- rawSystemProgramStdoutConf verb prog (withPrograms lbi) args+         rewriteFile outFile res++  forM_ (filter (\(tag,_) -> "x-types-" `isPrefixOf` tag && "file" `isSuffixOf` tag) xList) $+    \(fileTag, f) -> do+      let tag = reverse (drop 4 (reverse fileTag))+      info verb ("Ensuring that class hierarchy in "++f++" is up-to-date.")+      genFile typeGenProgram (typeOpts tag) f++  case lookup "x-signals-file" xList of+    Nothing -> return ()+    Just f -> do+      info verb ("Ensuring that callback hooks in "++f++" are up-to-date.")+      genFile signalGenProgram signalsOpts f++--FIXME: Cabal should tell us the selected pkg-config package versions in the+--       LocalBuildInfo or equivalent.+--       In the mean time, ask pkg-config again.++getPkgConfigPackages :: Verbosity -> LocalBuildInfo -> PackageDescription -> IO [PackageId]+getPkgConfigPackages verbosity lbi pkg =+  sequence+    [ do version <- pkgconfig ["--modversion", display pkgname]+         case simpleParse version of+           Nothing -> die "parsing output of pkg-config --modversion failed"+           Just v  -> return (PackageIdentifier pkgname v)+    | Dependency pkgname _ <- concatMap pkgconfigDepends (allBuildInfo pkg) ]+  where+    pkgconfig = rawSystemProgramStdoutConf verbosity+                  pkgConfigProgram (withPrograms lbi)++------------------------------------------------------------------------------+-- Dependency calculation amongst .chs files.+------------------------------------------------------------------------------++-- Given all files of the package, find those that end in .chs and extract the+-- .chs files they depend upon. Then return the PackageDescription with these+-- files rearranged so that they are built in a sequence that files that are+-- needed by other files are built first.+fixDeps :: PackageDescription -> IO PackageDescription+fixDeps pd@PD.PackageDescription {+          PD.library = Just lib@PD.Library {+            PD.exposedModules = expMods,+            PD.libBuildInfo = bi@PD.BuildInfo {+              PD.hsSourceDirs = srcDirs,+              PD.otherModules = othMods+            }}} = do+  let findModule m = findFileWithExtension [".chs.pp",".chs"] srcDirs+                       (joinPath (components m))+  mExpFiles <- mapM findModule expMods+  mOthFiles <- mapM findModule othMods++  -- tag all exposed files with True so we throw an error if we need to build+  -- an exposed module before an internal modules (we cannot express this)+  let modDeps = zipWith (ModDep True []) expMods mExpFiles+++                zipWith (ModDep False []) othMods mOthFiles+  modDeps <- mapM extractDeps modDeps+  let (expMods, othMods) = span mdExposed $ sortTopological modDeps+      badOther = map (fromMaybe "<no file>" . mdLocation) $+                 filter (not . mdExposed) expMods+  unless (null badOther) $+    die ("internal chs modules "++intercalate "," badOther+++         " depend on exposed chs modules; cabal needs to build internal modules first")+  return pd { PD.library = Just lib {+    PD.exposedModules = map mdOriginal expMods,+    PD.libBuildInfo = bi { PD.otherModules = map mdOriginal othMods }+  }}++data ModDep = ModDep {+  mdExposed :: Bool,+  mdRequires :: [ModuleName],+  mdOriginal :: ModuleName,+  mdLocation :: Maybe FilePath+}++instance Show ModDep where+  show x = show (mdLocation x)++instance Eq ModDep where+  ModDep { mdOriginal = m1 } == ModDep { mdOriginal = m2 } = m1==m2+instance Ord ModDep where+  compare ModDep { mdOriginal = m1 } ModDep { mdOriginal = m2 } = compare m1 m2++-- Extract the dependencies of this file. This is intentionally rather naive as it+-- ignores CPP conditionals. We just require everything which means that the+-- existance of a .chs module may not depend on some CPP condition.  +extractDeps :: ModDep -> IO ModDep+extractDeps md@ModDep { mdLocation = Nothing } = return md+extractDeps md@ModDep { mdLocation = Just f } = withUTF8FileContents f $ \con -> do+  let findImports acc (('{':'#':xs):xxs) = case (dropWhile (' ' ==) xs) of+        ('i':'m':'p':'o':'r':'t':' ':ys) ->+          case simpleParse (takeWhile ('#' /=) ys) of+            Just m -> findImports (m:acc) xxs +            Nothing -> die ("cannot parse chs import in "++f++":\n"+++                            "offending line is {#"++xs)+         -- no more imports after the first non-import hook+        _ -> return acc+      findImports acc (_:xxs) = findImports acc xxs+      findImports acc [] = return acc+  mods <- findImports [] (lines con)+  return md { mdRequires = mods }++-- Find a total order of the set of modules that are partially sorted by their+-- dependencies on each other. The function returns the sorted list of modules+-- together with a list of modules that are required but not supplied by this+-- in the input set of modules.+sortTopological :: [ModDep] -> [ModDep]+sortTopological ms = reverse $ fst $ foldl visit ([], S.empty) (map mdOriginal ms)+  where+  set = M.fromList (map (\m -> (mdOriginal m, m)) ms)+  visit (out,visited) m+    | m `S.member` visited = (out,visited)+    | otherwise = case m `M.lookup` set of+        Nothing -> (out, m `S.insert` visited)+        Just md -> (md:out', visited')+          where+            (out',visited') = foldl visit (out, m `S.insert` visited) (mdRequires md)++-- Check user whether install gtk2hs-buildtools correctly.+checkGtk2hsBuildtools :: [String] -> IO ()+checkGtk2hsBuildtools programs = do+  programInfos <- mapM (\ name -> do+                         location <- programFindLocation (simpleProgram name) normal+                         return (name, location)+                      ) programs+  let printError name = do+        putStrLn $ "Cannot find " ++ name ++ "\n" +                 ++ "Please install `gtk2hs-buildtools` first and check that the install directory is in your PATH (e.g. HOME/.cabal/bin)."+        exitFailure+  forM_ programInfos $ \ (name, location) ->+    when (isNothing location) (printError name)
+ LICENSE view
@@ -0,0 +1,675 @@+              GNU GENERAL PUBLIC LICENSE+                Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++                     Preamble++  The GNU General Public License is a free, copyleft license for+software and other kinds of works.++  The licenses for most software and other practical works are designed+to take away your freedom to share and change the works.  By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users.  We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors.  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, not+price.  Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++  To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights.  Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received.  You must make sure that they, too, receive+or can get the source code.  And you must show them these terms so they+know their rights.++  Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++  For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software.  For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++  Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so.  This is fundamentally incompatible with the aim of+protecting users' freedom to change the software.  The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable.  Therefore, we+have designed this version of the GPL to prohibit the practice for those+products.  If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++  Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary.  To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++  The precise terms and conditions for copying, distribution and+modification follow.++                TERMS AND CONDITIONS++  0. Definitions.++  "This License" refers to version 3 of the GNU General Public License.++  "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.+ +  "The Program" refers to any copyrightable work licensed under this+License.  Each licensee is addressed as "you".  "Licensees" and+"recipients" may be individuals or organizations.++  To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy.  The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++  A "covered work" means either the unmodified Program or a work based+on the Program.++  To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy.  Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++  To "convey" a work means any kind of propagation that enables other+parties to make or receive copies.  Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++  An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License.  If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++  1. Source Code.++  The "source code" for a work means the preferred form of the work+for making modifications to it.  "Object code" means any non-source+form of a work.++  A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++  The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form.  A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++  The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities.  However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work.  For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++  The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++  The Corresponding Source for a work in source code form is that+same work.++  2. Basic Permissions.++  All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met.  This License explicitly affirms your unlimited+permission to run the unmodified Program.  The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work.  This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++  You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force.  You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright.  Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++  Conveying under any other circumstances is permitted solely under+the conditions stated below.  Sublicensing is not allowed; section 10+makes it unnecessary.++  3. Protecting Users' Legal Rights From Anti-Circumvention Law.++  No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++  When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++  4. Conveying Verbatim Copies.++  You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++  You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++  5. Conveying Modified Source Versions.++  You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++    a) The work must carry prominent notices stating that you modified+    it, and giving a relevant date.++    b) The work must carry prominent notices stating that it is+    released under this License and any conditions added under section+    7.  This requirement modifies the requirement in section 4 to+    "keep intact all notices".++    c) You must license the entire work, as a whole, under this+    License to anyone who comes into possession of a copy.  This+    License will therefore apply, along with any applicable section 7+    additional terms, to the whole of the work, and all its parts,+    regardless of how they are packaged.  This License gives no+    permission to license the work in any other way, but it does not+    invalidate such permission if you have separately received it.++    d) If the work has interactive user interfaces, each must display+    Appropriate Legal Notices; however, if the Program has interactive+    interfaces that do not display Appropriate Legal Notices, your+    work need not make them do so.++  A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit.  Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++  6. Conveying Non-Source Forms.++  You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++    a) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by the+    Corresponding Source fixed on a durable physical medium+    customarily used for software interchange.++    b) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by a+    written offer, valid for at least three years and valid for as+    long as you offer spare parts or customer support for that product+    model, to give anyone who possesses the object code either (1) a+    copy of the Corresponding Source for all the software in the+    product that is covered by this License, on a durable physical+    medium customarily used for software interchange, for a price no+    more than your reasonable cost of physically performing this+    conveying of source, or (2) access to copy the+    Corresponding Source from a network server at no charge.++    c) Convey individual copies of the object code with a copy of the+    written offer to provide the Corresponding Source.  This+    alternative is allowed only occasionally and noncommercially, and+    only if you received the object code with such an offer, in accord+    with subsection 6b.++    d) Convey the object code by offering access from a designated+    place (gratis or for a charge), and offer equivalent access to the+    Corresponding Source in the same way through the same place at no+    further charge.  You need not require recipients to copy the+    Corresponding Source along with the object code.  If the place to+    copy the object code is a network server, the Corresponding Source+    may be on a different server (operated by you or a third party)+    that supports equivalent copying facilities, provided you maintain+    clear directions next to the object code saying where to find the+    Corresponding Source.  Regardless of what server hosts the+    Corresponding Source, you remain obligated to ensure that it is+    available for as long as needed to satisfy these requirements.++    e) Convey the object code using peer-to-peer transmission, provided+    you inform other peers where the object code and Corresponding+    Source of the work are being offered to the general public at no+    charge under subsection 6d.++  A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++  A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling.  In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage.  For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product.  A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++  "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source.  The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++  If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information.  But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++  The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed.  Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++  Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++  7. Additional Terms.++  "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law.  If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++  When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it.  (Additional permissions may be written to require their own+removal in certain cases when you modify the work.)  You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++  Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++    a) Disclaiming warranty or limiting liability differently from the+    terms of sections 15 and 16 of this License; or++    b) Requiring preservation of specified reasonable legal notices or+    author attributions in that material or in the Appropriate Legal+    Notices displayed by works containing it; or++    c) Prohibiting misrepresentation of the origin of that material, or+    requiring that modified versions of such material be marked in+    reasonable ways as different from the original version; or++    d) Limiting the use for publicity purposes of names of licensors or+    authors of the material; or++    e) Declining to grant rights under trademark law for use of some+    trade names, trademarks, or service marks; or++    f) Requiring indemnification of licensors and authors of that+    material by anyone who conveys the material (or modified versions of+    it) with contractual assumptions of liability to the recipient, for+    any liability that these contractual assumptions directly impose on+    those licensors and authors.++  All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10.  If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term.  If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++  If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++  Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++  8. Termination.++  You may not propagate or modify a covered work except as expressly+provided under this License.  Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++  However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++  Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++  Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License.  If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++  9. Acceptance Not Required for Having Copies.++  You are not required to accept this License in order to receive or+run a copy of the Program.  Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance.  However,+nothing other than this License grants you permission to propagate or+modify any covered work.  These actions infringe copyright if you do+not accept this License.  Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++  10. Automatic Licensing of Downstream Recipients.++  Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License.  You are not responsible+for enforcing compliance by third parties with this License.++  An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations.  If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++  You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License.  For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++  11. Patents.++  A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based.  The+work thus licensed is called the contributor's "contributor version".++  A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version.  For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++  Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++  In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement).  To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++  If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients.  "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.+  +  If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++  A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License.  You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++  Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++  12. No Surrender of Others' Freedom.++  If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all.  For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++  13. Use with the GNU Affero General Public License.++  Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work.  The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++  14. Revised Versions of this License.++  The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time.  Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++  Each version is given a distinguishing version number.  If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation.  If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++  If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++  Later license versions may give you additional or different+permissions.  However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++  15. Disclaimer of Warranty.++  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++  16. Limitation of Liability.++  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++  17. Interpretation of Sections 15 and 16.++  If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++              END OF TERMS AND CONDITIONS++     How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++    <one line to give the program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This program is free software: you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation, either version 3 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program.  If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++  If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++    <program>  Copyright (C) <year>  <name of author>+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+    This is free software, and you are welcome to redistribute it+    under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License.  Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++  You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++  The GNU General Public License does not permit incorporating your program+into proprietary programs.  If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library.  If this is what you want to do, use the GNU Lesser General+Public License instead of this License.  But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.+
+ Makefile view
@@ -0,0 +1,84 @@+GHCIFLAGS = -XForeignFunctionInterface -lxfconf-0 -idist/build/+PROFDIR   = Prof++### Artificial Makefile dependencies tree #############################++DISTDIR   = ./dist+SOURCES   = $(wildcard System/XFCE/Xfconf/*.chs Tests/*.hs)+BUILDDIR  = $(DISTDIR)/build+_MYBIN    = $(BUILDDIR)/tests/tests $(BUILDDIR)/testGlib/testGlib+_MYDOC    = $(DISTDIR)/doc/html/xfconf/index.html++### Cabal frontend ####################################################++all: build++configure: | $(DISTDIR)+$(DISTDIR): xfconf.cabal+	cabal configure -f "buildTests" --ghc-options="-prof -rtsopts=all"++build: $(_MYBIN)+$(_MYBIN): $(SOURCES) | configure+	cabal build++.PHONY: clean+clean:+	cabal clean+	rm -fr $(PROFDIR)++docs doc: $(_MYDOC)+$(_MYDOC): $(SOURCES) | configure+	cabal haddock++.PHONY: doc_view+doc_view: $(_MYDOC)+	xdg-open $^++### Debug helpers #####################################################++.PHONY: debug+debug: build+	ghci $(GHCIFLAGS) System/XFCE/Xfconf.hs;++.PHONY: debugTest+debugTest: build+	ghci $(GHCIFLAGS) Tests/Tests.hs;++.PHONY: debugGlib+debugGlib: build+	ghci $(GHCIFLAGS) Tests/TestGlib.hs;++.PHONY: debugDemo+debugDemo: build+	ghci $(GHCIFLAGS) Demo/Demo.hs;++### Launch pre-configured tests #######################################++.PHONY: watch+watch:+	watch xfconf-query -c quickcheck -vl++.PHONY: tests test+tests test: $(_MYBIN)+	$(BUILDDIR)/tests/tests --maximum-generated-tests=500 -j3++.PHONY: testGlib+testGlib: $(_MYBIN)+	$(BUILDDIR)/testGlib/testGlib++.PHONY: demo+demo: build+	runghc Demo/Demo.hs++### Profiling #########################################################++Prof/tests.prof:+	rm -fr $(PROFDIR) && mkdir -p $(PROFDIR)+	( cd $(PROFDIR)\+	; ../$(BUILDDIR)/tests/tests --maximum-generated-tests=500 -j3 +RTS -p -hc -sstderr\+	; hp2ps -c tests.hp )++profiling: Prof/tests.prof+	( cd $(PROFDIR)\+	; xdg-open tests.ps 2>&1 1>/dev/null\+	; less tests.prof )
+ README view
@@ -0,0 +1,70 @@+Summary+=======++Haskell bindings to XFCE 4.8 xfconf settings daemon.++Original xfconf API documentation can be found on:+	http://docs.xfce.org/api/xfconf/++Requirement+===========++GHC and xfconf-devel/libxfconf obviously :)++You will need a fairly new version of haddock too (>= 2.8).++Cabal should take care of the rest.++Status+======++Presently, the whole thing is (almost) no more hackish. The system was+integrated with cabal, a set of QuickCheck tests prove the storing and+retrieving of large data sets to work properly and the XfconfChannel*+objects inherit from regular gtk2hs-glib.GObjects.++Only Tests/TestGlib.hs appears broken.++Example+=======++An application of this library can be found with hThemes[0], a small+utility to quickly save and load pre-configured xfconf settings (notably+wallpapers, gtk+2 & xfwm4 themes).++[0]: https://patch-tag.com/r/obbele/hThemes/home++How to build+============++Just try this:++	bash $ make            # shortcut for cabal configure -f buildTests+	                       #          and cabal build++How to use the Tests/*.hs binaries+==================================++Those tests require a working version of XFCE >= 4.8, as well as the+haskell packages test-framework, test-framework-hunit, HUnit,+test-framework-quickcheck2 and QuickCheck. The demo program requires the+haskell binding for gtk. You can ask cabal to build it for you by+specifying the flag "buildTests":++	bash $ cabal configure -fbuildTests+	bash $ cabal build+	bash $ ./dist/build/tests/tests+	bash $ ./dist/build/testGlib/testGlib+	bash $ runghc Demo/Demo.hs++Or you can just quickly run them with one of the following shortcuts:+	+	bash $ make test(s)         # run with 500 test samples+	bash $ make testGlib        # test glib signals+	                            # (need a -threaded binary)+	bash $ make demo            # run the small xfconf bindings demo++You're welcomed to report any suggestions / bug reports to john obbele+AT gmail.++© Copyright 2010-2011 John Obbele. All Rights Reserved.
+ Setup.hs view
@@ -0,0 +1,7 @@+-- Setup file for a Gtk2Hs module. Contains only adjustments specific to this module,+-- all Gtk2Hs-specific boilerplate is stored in Gtk2HsSetup.hs which should be kept+-- identical across all modules.+import Gtk2HsSetup ( gtk2hsUserHooks )+import Distribution.Simple ( defaultMainWithHooks )++main = defaultMainWithHooks gtk2hsUserHooks
+ System/XFCE/Xfconf.hs view
@@ -0,0 +1,13 @@+module System.XFCE.Xfconf (+        module System.XFCE.Xfconf.Core,+        module System.XFCE.Xfconf.Error,+        module System.XFCE.Xfconf.Values,+        module System.XFCE.Xfconf.Channel,+        module System.XFCE.Xfconf.Binding+) where++import System.XFCE.Xfconf.Core+import System.XFCE.Xfconf.Error+import System.XFCE.Xfconf.Values+import System.XFCE.Xfconf.Channel+import System.XFCE.Xfconf.Binding
+ System/XFCE/Xfconf/Binding.chs view
@@ -0,0 +1,212 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}+-- -*-haskell-*-+--++{- | Xfconf-GObject Binding -- Functions to bind Xfconf properties to+   GObject properties.++   Note that this haskell API follows closely the original C API. Object+   properties should be given using their string name from the C API+   and not their Haskell name deriving from+   'System.Glib.Attributes.ReadWriteAttr'.++   For more information, see:+   http:\/\/docs.xfce.org\/api\/xfconf\/xfconf-xfconf-binding.html+-}+++#include <glib-object.h>+#include <xfconf/xfconf.h>++{# context lib="xfconf-0" prefix="xfconf" #}++module System.XFCE.Xfconf.Binding (+                -- * Detail+                -- $details++                -- * Example+                -- $example++                -- * Types+                XfconfBindingID,++                -- * Functions+                xfconfBind,+                xfconfBindGdkColor,+                xfconfUnbind,+                xfconfUnbindAll,+                xfconfUnbindByProperty,++                -- re-exports glib gtype constants+                module System.Glib.GTypeConstants++                ) where++import System.Glib.GObject    (GObject(GObject), GObjectClass(toGObject))+import System.Glib.GType      (GType)+import System.Glib.GTypeConstants+import System.Glib.UTFString++import System.XFCE.Xfconf.FFI+{#import System.XFCE.Xfconf.Types #}++{----------------------------------------------------------------------+-- Details+----------------------------------------------------------------------}++-- $details+-- Often it may be useful to bind an Xfconf property to a GObject+-- property. Settings dialogs often display the current value of an+-- Xfconf property, and a user may edit the value to change the value in+-- the Xfconf store. If the Xfconf property changes outside the settings+-- dialog, the user will usually want to see the settings dialog+-- automatically update to reflect the new value. With a single line+-- of code, Xfconf's binding functionality can automate all this.++{----------------------------------------------------------------------+-- Example (from Tests/Demo.hs)+----------------------------------------------------------------------}++-- $example+-- From the demo program in @\"Tests/Demo.hs\"@+--+-- @+-- chan \<- channelGet \"Demo\"+-- --+-- check0 \<- checkButtonNewWithLabel \"Check me \!\"+-- label0 \<- labelNew (Just \"\<null>\")+-- check1 \<- checkButtonNewWithLabel \"Check me !\"+-- --+-- let xfconf_property = \"\/check\"+-- \ \ \ \ obj_property    = \"active\"    -- toggleButtonActive attribute+-- --+-- -- Signals voodoo \\o\/+-- -- * bind check buttons from\/to xfconfd+-- -- * thus, their \"active\" state will remain synchronized+-- xfsig0 \<- xfconfBind chan xfconf_property bool check0 obj_property+-- xfsig1 \<- xfconfBind chan xfconf_property bool check1 obj_property+-- --+-- -- * monitor xfconfd and update the label accordingly+-- onPropertyChanged chan $ \\key maybeValue -> do+-- \ \ if key \/= xfconf_property+-- \ \ \ then return ()+-- \ \ \ else case maybeValue of+-- \ \ \ \ \ Just (XfconfBool True)  -> labelSetText label0 \"checked !\"+-- \ \ \ \ \ Just (XfconfBool False) -> labelSetText label0 \"unchecked !\"+-- \ \ \ \ \  _ -> labelSetText label0 \"UNKNOWN\"+-- --+-- -- Who cares about memory management nowadays ?+-- onDestroy window $ do+-- \ \ \ \ \ \ \ \ mainQuit+-- \ \ \ \ \ \ \ \ putStrLn \"ByeBye\"+-- @++{----------------------------------------------------------------------+-- Types and marshallers+----------------------------------------------------------------------}++-- | ID number that can be used to later remove corresponding bindings.+newtype XfconfBindingID = XfconfBindingID {unXfconfBindingID :: CULong}++-- | convenient marshall in function+withGObject :: GObjectClass obj => obj -> (Ptr () -> IO b) -> IO b+withGObject obj = let (GObject ptr) = toGObject obj+                  in withForeignPtr (castForeignPtr ptr)++{----------------------------------------------------------------------+-- Bindings+----------------------------------------------------------------------}++-- | Binds an Xfconf property to a GObject property. If the property is+-- changed via either the GObject or Xfconf, the corresponding property+-- will also be updated.+--+-- Note that @xfconf property type@ is required since @xfconf property@+-- may or may not already exist in the Xfconf store. The type of @object+-- property@ will be determined automatically. If the two types do not+-- match, a conversion will be attempted.+xfconfBind :: (XfconfChannelClass conf, GObjectClass obj)+           => conf               -- ^ channel+           -> String             -- ^ xfconf property+           -> GType              -- ^ xfconf property type+           -> obj                -- ^ object+           -> String             -- ^ object property+           -> IO XfconfBindingID -- ^ Xfconf binding ID+xfconfBind chan0 prop1 type2 obj3 prop4 =+    withUTFString prop1 $ \prop1' ->+    withGObject obj3 $ \obj3' ->+    withUTFString prop4 $ \prop4' ->+    let chan0' = toXfconfChannel chan0+        f = {#call unsafe g_property_bind #}+    in XfconfBindingID `fmap` f chan0' prop1' type2 obj3' prop4'++-- | Binds an Xfconf property to a GObject property of type+-- GDK_TYPE_COLOR (aka a GdkColor struct or simply 'Color' in Haskell+-- Pango library). If the property is changed via either the GObject or+-- Xfconf, the corresponding property will also be updated.+--+-- This is a special-case binding; the GdkColor struct is not ideal+-- as-is for binding to a property, so it is stored in the Xfconf store+-- as four 16-bit unsigned ints (red, green, blue, alpha). Since+-- GdkColor (currently) only supports RGB and not RGBA, the last value+-- will always be set to 0xFFFF.+xfconfBindGdkColor :: (XfconfChannelClass conf, GObjectClass obj)+                   => conf    -- ^ channel+                   -> String  -- ^ xfconf property+                   -> obj     -- ^ object+                   -> String  -- ^ object property+                   -> IO XfconfBindingID+xfconfBindGdkColor chan0 prop1 obj2 prop3 =+    withUTFString prop1 $ \prop1' ->+    withGObject obj2 $ \obj2' ->+    withUTFString prop3 $ \prop3' ->+    let chan0' = toXfconfChannel chan0+        f = {#call unsafe g_property_bind_gdkcolor #}+    in XfconfBindingID `fmap` f chan0' prop1' obj2' prop3'++-- | Removes an Xfconf/GObject property binding based on the binding+-- 'XfconfBindingID' number. See 'xfconfBind'.+xfconfUnbind :: XfconfBindingID -> IO ()+xfconfUnbind = {#call unsafe g_property_unbind #} . unXfconfBindingID++-- | Causes an Xfconf channel previously bound to a GObject property+-- (see 'xfconfBind') to no longer be bound.+xfconfUnbindByProperty :: (XfconfChannelClass conf, GObjectClass obj)+                       => conf    -- ^ channel+                       -> String  -- ^ channel property+                       -> obj     -- ^ object+                       -> String  -- ^ object property+                       -> IO ()+xfconfUnbindByProperty conf0 prop1 obj2 prop3 =+        withUTFString prop1 $ \prop1' ->+        withGObject obj2 $ \obj2' ->+        withUTFString prop3 $ \prop3' ->+        let conf0' = toXfconfChannel conf0+            f = {#call unsafe g_property_unbind_by_property #}+        in f conf0' prop1' obj2' prop3'++-- | Unbinds all Xfconf channel bindings (see 'xfconfBind')+-- to object. If object is an 'XfconfChannel', it will unbind all xfconf+-- properties on that channel. If object is a regular 'GObject' with+-- properties bound to a channel, all those bindings will be removed.+xfconfUnbindAll :: GObjectClass obj => obj -> IO ()+xfconfUnbindAll entity = withGObject entity unbind+  where unbind ptr = {#call unsafe g_property_unbind_all #} (castPtr ptr)++{----------------------------------------------------------------------+-- TODO++- xfconf-binding.h function list+-+- > bash $ sed '/^\(\/\| \*\|#\)/d' xfconf-binding.h | grep '('+-++DEMO    xfconf_g_property_bind+DONE    xfconf_g_property_bind_gdkcolor+DEMO    xfconf_g_property_unbind+DEMO    xfconf_g_property_unbind_all+DEMO    xfconf_g_property_unbind_by_property++----------------------------------------------------------------------}++-- vim:filetype=haskell:
+ System/XFCE/Xfconf/Channel.chs view
@@ -0,0 +1,808 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}+-- -*-haskell-*-+--+-- XXX: Property names are considered to be encoded in UTF-8 too+-- (string values are already encoded to / decoded from UTF-8).+++{- | An application-defined domain for storing configuration settings.++   For more information, see:+   http:\/\/docs.xfce.org\/api\/xfconf\/xfconf-xfconf-channel.html+-}+++#include <xfconf/xfconf.h>++{# context lib="xfconf-0" prefix="xfconf" #}++module System.XFCE.Xfconf.Channel (+                -- * Detail+                -- $detail++                -- * Example+                -- $example++                -- * Class Hierarchy+                -- $classHierarchy++                -- * Channel Type+                -- re-exported from "System.XFCE.Xfconf.Types"+                XfconfChannelClass,+                XfconfChannel,++                -- * Constructors+                channelGet,+                channelNew,+                channelNewWithPropertyBase,++                -- * Attributes+                -- | The name of the channel.+                channelGetName,+                channelName,+                -- | Base property path.+                channelGetPropertyBase,+                channelPropertyBase,+                -- | re-exported from "System.Glib.Attributes"+                get,++                -- * Signals+                onPropertyChanged,+                afterPropertyChanged,+                propertyChanged,++                -- * Methods+                -- ** Misc+                channelHasProperty,+                channelIsPropertyLocked,+                channelResetProperty,+                channelGetKeys,+                channelGetAllKeys,++                -- ** Basic values get/set+                -- $basicValues+                channelGetStringWithDefault,+                channelGetString,+                channelSetString,+                channelGetIntWithDefault,+                channelGetInt,+                channelSetInt,+                channelGetUIntWithDefault,+                channelGetUInt,+                channelSetUInt,+                channelGetUInt64WithDefault,+                channelGetUInt64,+                channelSetUInt64,+                channelGetDoubleWithDefault,+                channelGetDouble,+                channelSetDouble,+                channelGetBoolWithDefault,+                channelGetBool,+                channelSetBool,++                -- ** Special Xfconf value+                -- $special16bits+                channelGetUInt16WithDefault,+                channelGetUInt16,+                channelSetUInt16,+                channelGetInt16WithDefault,+                channelGetInt16,+                channelSetInt16,++                -- ** Complex values get/set+                -- $complexValues+                channelSetStringList,+                channelGetStringList,+                channelSetArray,+                channelGetArray,+                channelGetProperty,+                channelSetProperty,+                channelGetAllProperties,+                channelGetProperties,+                channelSetProperties++                ) where++import Control.Monad (when)+import Data.Char     (toLower)+import qualified Foreign.Concurrent as FC++import System.Glib.GValue+import System.Glib.Attributes     (ReadAttr, readAttr, get)+import System.Glib.Properties     (objectGetPropertyString)+import System.Glib.GTypeConstants (bool, invalid)+import System.Glib.UTFString++import System.XFCE.Xfconf.FFI+{#import System.XFCE.Xfconf.Types #}+{#import System.XFCE.Xfconf.Signals #}+{#import System.XFCE.Xfconf.Unsafe #}+{#import System.XFCE.Xfconf.Values #}+{#import System.XFCE.Xfconf.GHashTable #}++{----------------------------------------------------------------------+-- Documentation+----------------------------------------------------------------------}++-- $detail+-- An XfconfChannel is a representation of a restricted domain or+-- namespace that an application can define to store configuration+-- settings. This is to ensure that different applications do not store+-- configuration keys with the same names.++-- $example+-- Channel initialisation:+--+-- @+-- chan \<- channelGet \"demo\"+-- --+-- -- Clear channel+-- channelResetProperty chan \"\/\" True+-- --+-- channelSetInt        chan \"\/MyInt\"    42+-- channelSetString     chan \"\/MyString\" \"Hello world\"+-- channelSetStringList chan \"\/MyList\"   \[ \"haskell\", \"xfce\", \"xfconf\", \"gtk\" \]+-- channelSetProperty   chan \"\/MyArray\"  (Just \[1..5\] :: Maybe \[Int\])+-- @+--+-- Which we'll give us:+--+-- >>> channelGetAllKeys chan >>= mapM_ print+-- "/MyInt"+-- "/MyString"+-- "/MyList"+-- "/MyArray"+--+-- >>> channelGetAllProperties chan >>= mapM_ print+-- ("/MyInt",Just (XfconfInt 42))+-- ("/MyString",Just (XfconfString "Hello world"))+-- ("/MyList",Just (XfconfArray [XfconfString "haskell",XfconfString "xfce",XfconfString "xfconf",XfconfString "gtk"]))+-- ("/MyArray",Just (XfconfArray [XfconfInt 1,XfconfInt 2,XfconfInt 3,XfconfInt 4,XfconfInt 5]))++-- $classHierarchy+-- @+-- | 'GObject'+-- | +-----'XfconfChannel'+-- @++{----------------------------------------------------------------------+-- Types and constructors+----------------------------------------------------------------------}++foreign import ccall unsafe "g_object_unref"+    g_object_unref :: Ptr XfconfChannel -> IO ()++xfconfFinalizer :: Bool -> Ptr XfconfChannel -> IO ()+xfconfFinalizer unref ptr = do+    when unref (g_object_unref ptr)+    xfconfShutdown++-- | Either creates a new 'Channel', or fetches a singleton object for+-- channel_name. This function always returns a valid object; no+-- checking is done to see if the channel exists or has a valid name.+--+-- May throw a 'GError', see 'xfconfInit' for more information.+channelGet :: String  -- ^ channel name+           -> IO XfconfChannel+channelGet name = do+        xfconfInit+        ptr <- c_channel_get name'+        obj <- FC.newForeignPtr ptr (xfconfFinalizer False ptr)+        return $! XfconfChannel obj++  -- Xfconf backend does not like upper case characters.+  where name' = map toLower name++{#fun unsafe channel_get as c_channel_get+        { withUTFString* `String' -- ^ channel name+        } -> `Ptr XfconfChannel' id#}++-- | Creates a new channel using @name@ as the channel\'s identifier.+-- This function always returns a valid object; no checking is done to+-- see if the channel exists or has a valid name.+--+-- Note: use of this function is not recommended, in favor of+-- 'channelGet', which returns a singleton object and saves a little+-- memory. However, 'channelNew' can be useful in some cases where you+-- want to tie an 'XfconfChannel' \'s lifetime (and thus the lifetime of+-- connected signals and bound GObject properties) to the lifetime of+-- another object.+--+-- May throw a 'GError', see 'xfconfInit' for more information.+channelNew :: String  -- ^ channel @name@+           -> IO XfconfChannel+channelNew name = do+        xfconfInit+        objPtr <- c_channel_new name'+        obj <- FC.newForeignPtr objPtr (xfconfFinalizer True objPtr)+        return $! XfconfChannel obj++  -- Xfconf backend does not like upper case characters.+  where name' = map toLower name++{#fun unsafe channel_new as c_channel_new+        { withUTFString* `String' -- ^ channel name+        } -> `Ptr XfconfChannel' id#}++-- | Creates a new channel using @name@ as the channel's identifier,+-- restricting the accessible properties to be rooted at @property_base@.+-- This function always returns a valid object; no checking is done to+-- see if the channel exists or has a valid name.+--+-- May throw a 'GError', see 'xfconfInit' for more information.+channelNewWithPropertyBase :: String  -- ^ channel @name@+                           -> String  -- ^ root @property_base@+                           -> IO XfconfChannel+channelNewWithPropertyBase name prop = do+        xfconfInit+        objPtr <- c_channel_new_with_property_base name' prop+        obj <- FC.newForeignPtr objPtr (xfconfFinalizer True objPtr)+        return $! XfconfChannel obj++  -- Xfconf backend does not like upper case characters.+  where name' = map toLower name++{#fun unsafe channel_new_with_property_base as c_channel_new_with_property_base+        { withUTFString* `String' -- ^ channel name+        , withUTFString* `String' -- ^ property base+        } -> `Ptr XfconfChannel' id#}++{----------------------------------------------------------------------+-- Utilities+----------------------------------------------------------------------}++withXfconf :: XfconfChannelClass self+           => self -> (Ptr XfconfChannel -> IO b) -> IO b+withXfconf self = let (XfconfChannel ptr) = toXfconfChannel self+                  in withForeignPtr ptr++{----------------------------------------------------------------------+-- Attributes+----------------------------------------------------------------------}++channelName :: XfconfChannelClass self => ReadAttr self String+channelName = readAttr channelGetName++channelGetName :: XfconfChannelClass self => self -> IO String+channelGetName = objectGetPropertyString "channel-name"++channelPropertyBase :: XfconfChannelClass self => ReadAttr self String+channelPropertyBase = readAttr channelGetPropertyBase++channelGetPropertyBase :: XfconfChannelClass self => self -> IO String+channelGetPropertyBase = objectGetPropertyString "property-base"++{----------------------------------------------------------------------+-- Signals+----------------------------------------------------------------------}++-- | Emitted whenever a property on channel has changed. If the change+-- was caused by the removal of property, value will be unset; you will+-- receive 'Nothing' instead of ('Just' 'XfconfValue').+--+propertyChanged :: XfconfChannelClass self+                => Signal self (String -> Maybe XfconfValue -> IO ())+propertyChanged = Signal (connector "property-changed")+  where connector name isAfter obj =+          connect_STRING_PTR__NONE name isAfter obj . convertHandler++onPropertyChanged :: XfconfChannelClass self+                  => self+                  -> (String -> Maybe XfconfValue -> IO ())+                  -> IO (ConnectId self)+onPropertyChanged gc handler =+  connect_STRING_PTR__NONE "property-changed" False gc+        (convertHandler handler)++afterPropertyChanged :: XfconfChannelClass self+                     => self+                     -> (String -> Maybe XfconfValue -> IO ())+                     -> IO (ConnectId self)+afterPropertyChanged gc handler =+  connect_STRING_PTR__NONE "property-changed" True gc+        (convertHandler handler)++-- C handler is "Obj -> CString -> Ptr () -> Ptr () -> IO ()"++-- haskell "pre-marshalled" handler is+--    "String -> Ptr () -> IO ()"++-- we want to pass a "String -> Maybe XfconfValue -> IO ()" instead++-- ... hence we convert Ptr GValue to Maybe XfconfValue+convertHandler :: (String -> Maybe XfconfValue -> IO ())+               -> (String -> Ptr () -> IO ())+convertHandler handler = \key ptr1 -> do+  let gvalue = GValue (castPtr ptr1)+  gtype <- valueGetType gvalue+  if gtype == invalid+     then handler key Nothing+     else do xvalue <- toXfconfValue gvalue+             handler key (Just xvalue)++{----------------------------------------------------------------------+-- Methods: misc+----------------------------------------------------------------------}++-- | Checks to see if property exists on channel.+{#fun unsafe channel_has_property as ^+        `XfconfChannelClass self' =>+        { withXfconf*    `self'   -- ^ channel+        , withUTFString* `String' -- ^ property+        } -> `Bool' toBool #}++-- | Queries whether or not property on channel is locked by system+-- policy. If the property is locked, calls to 'setProperty' (or any of+-- the \"set\" family of functions) or 'resetProperty' will fail.+{#fun unsafe channel_is_property_locked as ^+        `XfconfChannelClass self' =>+        { withXfconf*    `self'    -- ^ channel+        , withUTFString* `String'  -- ^ property+        } -> `Bool' toBool #}++-- | Resets properties starting at (and including) the 'String'+-- property_base. If recursive is @True@, will also reset all properties+-- that are under property_base in the property hierarchy.+--+-- A bit of an explanation as to what this function actually does: Since+-- Xfconf backends are expected to support setting defaults via what you+-- might call \"optional schema,\" you can't really \"remove\"+-- properties.  Since the client library can't know if a channel+-- provides default values (or even if the backend supports it!), at+-- best it can only reset properties to their default values. To+-- retrieve all properties in the channel, specify \"/\".+{#fun unsafe channel_reset_property as ^+        `XfconfChannelClass self' =>+        { withXfconf*    `self'    -- ^ channel+        , withUTFString* `String'  -- ^ property base+        , fromBool       `Bool'    -- ^ recursive+        } -> `()' id#}++-- | Retrieves the list of properties from 'Channel'. The value of the+-- property specified by the 'String' property_base and all+-- sub-properties are retrieved. To retrieve all properties in the+-- channel, specify \"/\".+channelGetKeys :: XfconfChannelClass self => self -> String -> IO [String]+channelGetKeys chan prop = do+        maybeGHT <- c_get_properties chan prop+        case maybeGHT of+             Nothing  -> return []+             Just ght -> gHashTableKeys ght++-- | Alias to @channelGetKeys channel \"/\"@+channelGetAllKeys :: XfconfChannelClass self => self -> IO [String]+channelGetAllKeys chan = channelGetKeys chan "/"++{----------------------------------------------------------------------+-- Basic values set/get aka the boring stuff++-- The following functions are a relic of my first FFI, hsc2hs and c2hs+-- experimentation. All the get/set-ters could probably be based on+-- the unique channelGetProperty function.+--+-- ... and I should probably provide a fromXfconfValue function to ease+-- this operation ...+----------------------------------------------------------------------}++-- $basicValues+-- The following functions are simple getters\/setters for dead simple+-- glib type (gint, gboolean, gchar*, ...). Set functions come in two+-- flavors:+--+--  * @getTypeWidthDefault@ takes a third parameter which is the default+--    fallback value returned by xfconf if no value was found+--+--  * @getType@ are convenience function which returned hard-coded+--    default values. (0 for (u)ints, floats and doubles, \"\" for+--    strings, False for booleans, etc. )+--+-- Note that if you wish to \"unset\" a value, you should probably use+-- 'channelResetProperty'.++--- INT+{#fun unsafe channel_get_int as channelGetIntWithDefault+        `XfconfChannelClass self' =>+        { withXfconf*     `self'    -- ^ channel pointer+        , withUTFString*  `String'  -- ^ property+        , fromIntegral    `Int32'   -- ^ fallback value+        } -> `Int32' fromIntegral #}++channelGetInt :: XfconfChannelClass self => self -> String -> IO Int32+channelGetInt chan prop = channelGetIntWithDefault chan prop 0++{#fun unsafe channel_set_int as ^+        `XfconfChannelClass self' =>+        { withXfconf*     `self'    -- ^ channel pointer+        , withUTFString*  `String'  -- ^ property+        , fromIntegral    `Int32'   -- ^ new value+        } -> `Bool' toBool #}++--- UINT+{#fun unsafe channel_get_uint as channelGetUIntWithDefault+        `XfconfChannelClass self' =>+        { withXfconf*     `self'    -- ^ channel pointer+        , withUTFString*  `String'  -- ^ property+        , fromIntegral    `Word32'  -- ^ fallback value+        } ->  `Word32' fromIntegral #}++channelGetUInt :: XfconfChannelClass self => self -> String -> IO Word32+channelGetUInt chan prop = channelGetUIntWithDefault chan prop 0++{#fun unsafe channel_set_uint as channelSetUInt+        `XfconfChannelClass self' =>+        { withXfconf*     `self'    -- ^ channel pointer+        , withUTFString*  `String'  -- ^ property+        , fromIntegral    `Word32'  -- ^ new value+        } -> `Bool' toBool #}++--- UINT64+{#fun unsafe channel_get_uint64 as channelGetUInt64WithDefault+        `XfconfChannelClass self' =>+        { withXfconf*     `self'    -- ^ channel pointer+        , withUTFString*  `String'  -- ^ property+        , fromIntegral    `Word64'  -- ^ fallback value+        } -> `Word64' fromIntegral #}++channelGetUInt64 :: XfconfChannelClass self => self -> String -> IO Word64+channelGetUInt64 chan prop = channelGetUInt64WithDefault chan prop 0++{#fun unsafe channel_set_uint64 as channelSetUInt64+        `XfconfChannelClass self' =>+        { withXfconf*     `self'    -- ^ channel pointer+        , withUTFString*  `String'  -- ^ property+        , fromIntegral    `Word64'  -- ^ new value+        } -> `Bool' toBool #}++--- Boolean+{#fun unsafe channel_get_bool as channelGetBoolWithDefault+        `XfconfChannelClass self' =>+        { withXfconf*     `self'    -- ^ channel pointer+        , withUTFString*  `String'  -- ^ property+        , fromBool        `Bool'    -- ^ fallback value+        } -> `Bool' toBool #}++channelGetBool :: XfconfChannelClass self => self -> String -> IO Bool+channelGetBool chan prop = channelGetBoolWithDefault chan prop False++{#fun unsafe channel_set_bool as ^+        `XfconfChannelClass self' =>+        { withXfconf*     `self'    -- ^ channel pointer+        , withUTFString*  `String'  -- ^ property+        , fromBool        `Bool'    -- ^ new value+        } -> `Bool' toBool #}++--- Double+{#fun unsafe channel_get_double as channelGetDoubleWithDefault+        `XfconfChannelClass self' =>+        { withXfconf*     `self'    -- ^ channel pointer+        , withUTFString*  `String'  -- ^ property+        , realToFrac      `Double'  -- ^ fallback value+        } -> `Double' realToFrac #}++channelGetDouble :: XfconfChannelClass self => self -> String -> IO Double+channelGetDouble chan prop = channelGetDoubleWithDefault chan prop 0.0++{#fun unsafe channel_set_double as ^+        `XfconfChannelClass self' =>+        { withXfconf*     `self'    -- ^ channel pointer+        , withUTFString*  `String'  -- ^ property+        , realToFrac      `Double'  -- ^ new value+        } -> `Bool' toBool #}++--- String+{#fun unsafe channel_get_string as channelGetStringWithDefault+        `XfconfChannelClass self' =>+        { withXfconf*     `self'    -- ^ channel pointer+        , withUTFString*  `String'  -- ^ property+        , withUTFString*  `String'  -- ^ fallback value+        } ->  `String' readUTFString* #}++channelGetString :: XfconfChannelClass self => self -> String -> IO String+channelGetString channel prop = channelGetStringWithDefault channel prop "N/A"++{#fun unsafe channel_set_string as ^+        `XfconfChannelClass self' =>+        { withXfconf*     `self'    -- ^ channel pointer+        , withUTFString*  `String'  -- ^ property+        , withUTFString*  `String'  -- ^ new value+        } -> `Bool' toBool #}++{----------------------------------------------------------------------+-- gint16 and guint16+----------------------------------------------------------------------}++-- $special16bits+-- The same remark as for the previous \"basic values\" applies.++-- common infrastructure, since xfconf doesn't have raw get/set for+-- uint16 and int16, we will use channel_get/set_property with GValues+foreign import ccall unsafe "xfconf.h xfconf_channel_get_property"+        c_get_property :: Ptr XfconfChannel -- ^ channel pointer+                       -> Ptr CChar         -- ^ property+                       -> Ptr GValue        -- ^ gvalue*+                       -> IO CInt           -- ^ success++foreign import ccall unsafe "xfconf.h xfconf_channel_set_property"+        c_set_property :: Ptr XfconfChannel -- ^ channel pointer+                       -> Ptr CChar         -- ^ property+                       -> Ptr GValue        -- ^ gvalue*+                       -> IO CInt           -- ^ success++--- UINT16+channelGetUInt16WithDefault :: XfconfChannelClass self+                            => self -> String -> Word16 -> IO Word16+channelGetUInt16WithDefault chan property i =+        withXfconf chan $ \chanPtr ->+        withUTFString property $ \prop ->+        allocaGValue $ \(GValue gPtr) -> do+        r <- c_get_property chanPtr prop gPtr+        case toBool r of+             False -> return i+             -- FIXME: Integer store as uint16 are retrieved as UInt.+             -- This is a bug present in the C version of the library.+             -- Not the present FFI binding fault.+             True  -> do { v <- toXfconfValue (GValue gPtr)+                         ; case v of+                         ;   XfconfUInt16 x -> return x+                         ;   XfconfUInt x -> return (fromIntegral x)+                         ;   _ -> error "Cannot decode gPtr UInt16" }++channelGetUInt16 :: XfconfChannelClass self+                 => self -> String -> IO Word16+channelGetUInt16 chan prop = channelGetUInt16WithDefault chan prop 0++channelSetUInt16 :: XfconfChannelClass self+                 => self -> String -> Word16 -> IO Bool+channelSetUInt16 chan property i =+        withXfconf chan $ \chanPtr ->+        withUTFString property $ \prop ->+        allocaGValue $ \gvalue@(GValue gPtr) -> do+        valueInit gvalue uint16+        valueSetUInt16 gvalue (fromIntegral i)+        r <- c_set_property chanPtr prop gPtr+        return (toBool r)++--- INT16+channelGetInt16WithDefault :: XfconfChannelClass self+                           => self -> String -> Int16 -> IO Int16+channelGetInt16WithDefault chan property i =+        withXfconf chan $ \chanPtr ->+        withUTFString property $ \prop ->+        allocaGValue $ \gvalue@(GValue gPtr) -> do+        r <- c_get_property chanPtr prop gPtr+        case toBool r of+             False -> return i+             -- FIXME: Same \"bug\" as before, xfconfd return Int16 as+             -- simple Int. So we cheat a little in Haskell to keep+             -- things coherent.+             True  -> do { v <- toXfconfValue gvalue+                         ; case v of+                         ;   XfconfInt16 x -> return x+                         ;   XfconfInt x -> return (fromIntegral x)+                         ;   _ -> error "Cannot decode gPtr Int16" }++channelGetInt16 :: XfconfChannelClass self+                => self -> String -> IO Int16+channelGetInt16 chan prop = channelGetInt16WithDefault chan prop 0++channelSetInt16 :: XfconfChannelClass self+                => self -> String -> Int16 -> IO Bool+channelSetInt16 chan property i =+        withXfconf chan $ \chanPtr ->+        withUTFString property $ \prop ->+        allocaGValue $ \gvalue@(GValue gPtr) -> do+        valueInit gvalue int16+        valueSetInt16 gvalue (fromIntegral i)+        r <- c_set_property chanPtr prop gPtr+        return (toBool r)++{----------------------------------------------------------------------+-- Complex values set/get aka the f***ing stuff+----------------------------------------------------------------------}++-- $complexValues+-- C Arrays, structures and named structures are not implemented.+-- (correction: you can now retrieve and store arrays, just do not play+-- with complex arrays -- eg. no array of arrays -- and be careful of+-- the difference betwwen 'channelSetStringList', 'channelGetArray' or+-- 'channelGetProperty').++--- String List+{#fun unsafe channel_get_string_list as ^+        `XfconfChannelClass self' =>+        { withXfconf*          `self'    -- ^ channel pointer+        , withUTFString*       `String'  -- ^ property+        } -> `[String]' readUTFStrings* #}++  where readUTFStrings ptr = if ptr == nullPtr+                                then return []+                                else readUTFStringArray0 ptr++{#fun unsafe channel_set_string_list as c_set_string_list+        `XfconfChannelClass self' =>+        { withXfconf*          `self'     -- ^ channel pointer+        , withUTFString*       `String'   -- ^ property+        , withUTFStringArray0* `[String]' -- ^ new value+        } -> `Bool' toBool #}++-- | Handles [] empty string lists by resetting the value with+-- 'channelResetProperty'+channelSetStringList :: XfconfChannelClass self+                     => self -> String -> [String] -> IO Bool+channelSetStringList ch prop [] = channelResetProperty ch prop False >> return True+channelSetStringList ch prop xs = c_set_string_list ch prop xs++channelGetArray :: XfconfChannelClass self+                => self -> String -> IO [XfconfValue]+channelGetArray channel property = do+        result <- channelGetProperty channel property+        case result of+             Just (XfconfArray xs) -> return xs+             Nothing               -> return []+             _                     -> error "not a XfconfArray"++channelSetArray :: (XfconfChannelClass self, XfconfValueClass a)+                => self -> String -> [a] -> IO Bool+channelSetArray channel property xs =+        withXfconf channel $ \conf ->+        withUTFString property $ \prop ->+        mapM toXfconfValue xs >>= \values ->+        allocaGValueArray values $ \(GValue gptr) ->+        c_set_property conf prop gptr >>= return . toBool+++-- | Generic function for retrieving 'XfconfValue's. As for+-- 'channelGetProperties', only work with the limited set of simple+-- types supported by "System.XFCE.Xfconf.Values".+channelGetProperty :: XfconfChannelClass self+                   => self -> String -> IO (Maybe XfconfValue)+channelGetProperty chan property =+        withXfconf chan $ \chanPtr ->+        withUTFString property $ \prop ->+        allocaGValue $ \gvalue@(GValue gPtr) -> do+        success <- c_get_property chanPtr prop gPtr+        case toBool success of+          False -> do -- gvalue was not initialize by c_get_property+                      -- allocaGValue will try to unset it+                      -- and throw an error if our gvalue stay as it is+                      valueInit gvalue bool+                      return Nothing+          True  -> Just `fmap` toXfconfValue gvalue++-- | Generic function for storing 'XfconfValue's. As for+-- 'channelGetProperties', only work with the limited set of simple+-- types supported by "System.XFCE.Xfconf.Values".+--+-- Reset property and return True if @Maybe XfconfValue@ is 'Nothing' or+-- throw an error if the value is an instance of @Just+-- ('XfconfNotImplemented' t)@.+channelSetProperty :: (XfconfChannelClass self, XfconfValueClass a)+                   => self -> String -> Maybe a -> IO Bool++channelSetProperty ch p Nothing  = do+        channelResetProperty ch p False+        return True++channelSetProperty ch p (Just v) = do+        value <- toXfconfValue v+        case value of+                XfconfInt        i -> channelSetInt        ch p i+                XfconfUInt       i -> channelSetUInt       ch p i+                XfconfUInt64     i -> channelSetUInt64     ch p i+                XfconfDouble     d -> channelSetDouble     ch p d+                XfconfBool       b -> channelSetBool       ch p b+                XfconfString     s -> channelSetString     ch p s+                XfconfInt16      i -> channelSetInt16      ch p i+                XfconfUInt16     i -> channelSetUInt16     ch p i+                XfconfStringList l -> channelSetStringList ch p l+                XfconfArray      a -> channelSetArray      ch p a+                _                  -> error "unknown XfconfValue type"++-- | Retrieves multiple properties from 'Channel' and stores them in a+-- 'GHashTable' in which the keys correspond to the string property+-- names, and the values correspond to variant 'GValue' values. The+-- value of the property specified by the 'String' property_base and all+-- sub-properties are retrieved. To retrieve all properties in the+-- channel, specify \"/\".+{#fun unsafe channel_get_properties as c_get_properties+        `XfconfChannelClass self' =>+        { withXfconf*    `self'    -- ^ channel+        , withUTFString* `String'  -- ^ property base+        } -> `Maybe GHashTable' marshallGHashTable* #}++  where marshallGHashTable ptr = if ptr == nullPtr+                                    then return Nothing+                                    else Just `fmap` mkGHashTable ptr++-- | A convenience function returning an association list [(key,+-- value)]. Work only for the data types defined in+-- "System.XFCE.Xfconf.Values" (i.e. no (named) structures).+-- See also the limitation imposed by 'gHashTableLookup'. The value of+-- the property specified by the 'String' property_base and all+-- sub-properties are retrieved. To retrieve all properties in the+-- channel, specify \"/\".+channelGetProperties :: XfconfChannelClass self+                     => self -> String -> IO [(String, Maybe XfconfValue)]+channelGetProperties chan prop = do+        maybeGHT <- c_get_properties chan prop+        case maybeGHT of+             Nothing  -> return []+             Just ght -> do keys <- gHashTableKeys ght+                            values <- mapM (gLookup ght) keys+                            return (zip keys values)++  where gLookup :: GHashTable -> String -> IO (Maybe XfconfValue)+        gLookup ght key = do value <- gHashTableLookup ght key+                             case value of+                                 Nothing -> return Nothing+                                 Just x -> Just `fmap` toXfconfValue x++-- | Alias to @channelGetProperties channel \"/\"@+channelGetAllProperties :: XfconfChannelClass self => self+                        -> IO [(String, Maybe XfconfValue)]+channelGetAllProperties c = channelGetProperties c "/"++-- | A convenience function equivalent to+-- @+--    mapM (\(k,v) -> channelSetProperty channel k v) properties+-- @+channelSetProperties :: (XfconfChannelClass self, XfconfValueClass a)+                     => self -> [(String, Maybe a)] -> IO [Bool]+channelSetProperties chan = mapM (\(k,v) -> channelSetProperty chan k v)++{----------------------------------------------------------------------+-- TODO++- xfconf-channel.h function list+-+- > bash $ sed '/^\(\/\| \*\|#\)/d' xfconf-channel.h | grep '('+-+DONE    xfconf_channel_get_type+TESTED  xfconf_channel_get+TESTED  xfconf_channel_new+TESTED  xfconf_channel_new_with_property_base+TESTED  xfconf_channel_has_property+TESTED  xfconf_channel_is_property_locked+TESTED  xfconf_channel_reset_property+TESTED  xfconf_channel_get_properties+TESTED  xfconf_channel_get_string+TESTED  xfconf_channel_set_string+TESTED  xfconf_channel_get_int+TESTED  xfconf_channel_set_int+TESTED  xfconf_channel_get_uint+TESTED  xfconf_channel_set_uint+TESTED  xfconf_channel_get_uint64+TESTED  xfconf_channel_set_uint64+TESTED  xfconf_channel_get_double+TESTED  xfconf_channel_set_double+TESTED  xfconf_channel_get_bool+TESTED  xfconf_channel_set_bool+TESTED  xfconf_channel_get_string_list+TESTED  xfconf_channel_set_string_list+PARTIAL xfconf_channel_get_property+PARTIAL xfconf_channel_set_property+SOMEHOW xfconf_channel_get_array+        xfconf_channel_get_array_valist+        xfconf_channel_get_arrayv+SOMEHOW xfconf_channel_set_array+        xfconf_channel_set_array_valist+        xfconf_channel_set_arrayv+        xfconf_channel_get_named_struct+        xfconf_channel_set_named_struct+        xfconf_channel_get_struct+        xfconf_channel_get_struct_valist+        xfconf_channel_get_structv+        xfconf_channel_set_struct+        xfconf_channel_set_struct_valist+        xfconf_channel_set_structv++- xfconf-channel.h attributes list+TESTED  channel-name+TESTED  property-base++- xfconf-channel.h signals list+TESTED  property-changed++----------------------------------------------------------------------}++-- vim:filetype=haskell:
+ System/XFCE/Xfconf/Core.chs view
@@ -0,0 +1,44 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}+-- vim:filetype=haskell:+--++-- XXX: Should we consider property names to be encoded in UTF-8 too+-- (string values are already encoded to / decoded from UTF-8).++{- | Core functionalities for libxfconf.++   There is actually only one core function : 'xfconfListChannels'.+   Access to the C functions xfconf_init() and xfconf_shutdown() are+   available in the "System.XFCE.Xfconf.Unsafe" module and should, in+   most cases, not be used in Haskell.++   For more information, see:+   http:\/\/docs.xfce.org\/api\/xfconf\/xfconf-xfconf.html+-}+++#include <xfconf/xfconf.h>++{# context lib="xfconf-0" prefix="xfconf" #}++module System.XFCE.Xfconf.Core (+                xfconfListChannels,+                ) where++import Control.Exception      (bracket_)++import System.Glib.UTFString++import System.XFCE.Xfconf.FFI+{#import System.XFCE.Xfconf.Unsafe #}++{----------------------------------------------------------------------+-- Core+----------------------------------------------------------------------}++-- | List the names of available channels.+xfconfListChannels :: IO [String]+xfconfListChannels = bracket_ xfconfInit xfconfShutdown $+        {#call unsafe xfconf_list_channels #} >>= readUTFStringArray0++-- TODO: implement xfconf_named_struct_register
+ System/XFCE/Xfconf/Error.chs view
@@ -0,0 +1,70 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}++-- | Xfconf library and daemon error descriptions+-- +-- Both the Xfconf daemon and library provide error information via the+-- use of GErrors.+--+-- For more information, see:+--  http:\/\/docs.xfce.org\/api\/xfconf\/xfconf-xfconf-errors.html+++#include <xfconf/xfconf.h>++{# context lib="xfconf-0" #}++module System.XFCE.Xfconf.Error (+                XfconfError(..),+                xfconfErrorDomain+                ) where++import System.Glib.GError++import System.XFCE.Xfconf.FFI++{----------------------------------------------------------------------+-- Xfconf Error+----------------------------------------------------------------------}++-- | The 'GErrorDomain' for Xfconf.+xfconfErrorDomain :: GErrorDomain+xfconfErrorDomain = {#call pure unsafe xfconf_get_error_quark#}++{- | An enumeration listing the different kinds of errors under the+   'xfconfErrorDomain' domain.++     [@xfconfErrorUnknown@]+         An unknown error occurred++     [@xfconfErrorChannelNotFound@]+         The specified channel does not exist++     [@xfconfErrorPropertyNotFound@]+         The specified property does not exist on the channel++     [@xfconfErrorReadFailure@]+         There was a failure reading from the configuration store++     [@xfconfErrorWriteFailure@]+         There was a failure writing to the configuration store++     [@xfconfErrorPermissionDenied@]+         The user is not allowed to read or write to the channel or+         property++     [@xfconfErrorInternalError@]+         An internal error (likely a bug in xfconf) occurred++     [@xfconfErrorNoBackend@]+         No backends were found, or those found could not be loaded++     [@xfconfErrorInvalidProperty@]+         The property name specified was invalid++     [@xfconfErrorInvalidChannel@]+         The channel name specified was invalid +-} +{#enum XfconfError {underscoreToCase} #}++instance GErrorClass XfconfError where+        gerrorDomain _ = xfconfErrorDomain
+ System/XFCE/Xfconf/FFI.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE ForeignFunctionInterface #-}+--+--++module System.XFCE.Xfconf.FFI (+        -- * Glib+        g_free,++        -- * Re-exported Common FFI stuff+        module Foreign,+        module Foreign.C.Types,+        module Foreign.C.String+        ) where++import Foreign+import Foreign.C.Types+import Foreign.C.String++foreign import ccall unsafe "glib.h g_free"+  g_free :: Ptr a -> IO ()
+ System/XFCE/Xfconf/GHashTable.chs view
@@ -0,0 +1,96 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}+-- vim:filetype=haskell:++{- | A limited binding to glib GHashTable structures. We only handle+   hash tables as returned by @xfconf_channel_get_properties@. They have+   @gchar *@ keys and @GValue *@ values.+  +   Objectives:++        * get back the list of keys when keys are strings++        * extract values+-}++#include <glib.h>++{# context lib="glib" prefix="g_hash_table" #}++module System.XFCE.Xfconf.GHashTable (+        -- * Private data type+        GHashTable,+        -- * Marshalling functions+        withGHashTable,+        mkGHashTable,+        -- * Query functions+        gHashTableKeys,+        gHashTableLookup+        ) where++import Control.Monad          ((>=>))++import System.Glib.GList+import System.Glib.GValue+import System.Glib.UTFString++import System.XFCE.Xfconf.FFI++-- | Haskell representation of a C @GHashTable*@ with @gchar *@ keys and+-- @GValue*@ values. Memory management is automatically managed by a+-- special Haskell finalizer calling @g_hash_table_destroy@.+{#pointer *GHashTable as GHashTable foreign newtype #}+-- withGHashTable is auto-generated by C2HS, but not by gtk2hsC2hs+withGHashTable :: GHashTable -> (Ptr GHashTable -> IO b) -> IO b+withGHashTable (GHashTable ptr) = withForeignPtr ptr++-- | The glib finalizer for hash tables.+foreign import ccall unsafe "glib.h &g_hash_table_destroy"+        c_destroy :: FinalizerPtr GHashTable++{- | Marshal out a raw C @GHashTable*@ by wrapping it in the Haskell+   type 'GHashTable' and adding it a finalizer (which calls+   @g_hash_table_destroy@).+  +   Should be called for every function returning a @GHashTable*@, see+   for example in /System.XFCE.Xfconf.Channel.chs/:+  +  @+        {#fun unsafe get_properties as ^+                { channelPtr     \`Channel\' -- ^ channel pointer+                , withUTFString* \`String\'  -- ^ property base+                } -> \`GHashTable\' mkGHashTable* #}+  @+-} +mkGHashTable :: Ptr GHashTable -> IO (GHashTable)+mkGHashTable ptr = GHashTable `fmap` newForeignPtr c_destroy ptr++-- XXX: fromGList calls g_list_delete_link which I suppose is the same+--      as calling g_list_free+-- XXX: readGList read whereas fromGList read *and* free the list+--      peekUTFString read whereas readUTFString read *and* free the str+--      somewhat, I feel completely lost (^^)+-- XXX: we do NOT readUTFString, we just peek them !+--      the GHashTablePtr finalizer should take care itself of freeing+--      them+-- | Retrieves every key inside a 'GHashTable'. The returned data is+-- valid until the table is modified. +{#fun unsafe get_keys as gHashTableKeys+        { withGHashTable* `GHashTable'+        } -> `[String]' marshallOut* #}+  where marshallOut = fromGList >=> mapM peekUTFString++-- | Looks up a key in a GHashTable. Note that this function cannot+-- distinguish between a key that is not present and one which is+-- present and has the value 'Nothing'.+{#fun unsafe lookup as gHashTableLookup+        { withGHashTable*  `GHashTable'+        , withUTFString'*  `String'+        } -> `Maybe GValue' marshallGValue #}++  where withUTFString' :: String -> (Ptr () -> IO b) -> IO b+        withUTFString' s io = withUTFString s (io . castPtr)++        marshallGValue :: Ptr a -> Maybe GValue+        marshallGValue ptr = if ptr == nullPtr+                                then Nothing+                                else Just . GValue . castPtr $ ptr
+ System/XFCE/Xfconf/Signals.chs view
@@ -0,0 +1,76 @@+{-# OPTIONS_HADDOCK hide #-}+-- -*-haskell-*-+-- -------------------- automatically generated file - do not edit ------------+--  Callback installers for the GIMP Toolkit (GTK) Binding for Haskell+--+--  Author : Axel Simon+--+--  Created: 1 July 2000+--+--  Copyright (C) 2000-2005 Axel Simon+--+--  This library is free software; you can redistribute it and/or+--  modify it under the terms of the GNU Lesser General Public+--  License as published by the Free Software Foundation; either+--  version 2.1 of the License, or (at your option) any later version.+--+--  This library is distributed in the hope that it will be useful,+--  but WITHOUT ANY WARRANTY; without even the implied warranty of+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU+--  Lesser General Public License for more details.+--+-- #hide++-- These functions are used to connect signals to widgets. They are auto-+-- matically created through HookGenerator.hs which takes a list of possible+-- function signatures that are included in the GTK sources (gtkmarshal.list).+--+-- The object system in the second version of GTK is based on GObject from+-- GLIB. This base class is rather primitive in that it only implements+-- ref and unref methods (and others that are not interesting to us). If+-- the marshall list mentions OBJECT it refers to an instance of this +-- GObject which is automatically wrapped with a ref and unref call.+-- Structures which are not derived from GObject have to be passed as+-- BOXED which gives the signal connect function a possibility to do the+-- conversion into a proper ForeignPtr type. In special cases the signal+-- connect function use a PTR type which will then be mangled in the+-- user function directly. The latter is needed if a signal delivers a+-- pointer to a string and its length in a separate integer.+--+module System.XFCE.Xfconf.Signals (+  module System.Glib.Signals,++  connect_STRING_PTR__NONE,+  +  ) where++import Control.Monad	(liftM)++import System.Glib.FFI+import System.Glib.UTFString   (peekUTFString,maybePeekUTFString)+import System.Glib.GError      (failOnGError)+{#import System.Glib.Signals#}+{#import System.Glib.GObject#} +++{#context lib="gtk" prefix="gtk" #}+++-- Here are the generators that turn a Haskell function into+-- a C function pointer. The fist Argument is always the widget,+-- the last one is the user g_pointer. Both are ignored.+++connect_STRING_PTR__NONE :: +  GObjectClass obj => SignalName ->+  ConnectAfter -> obj ->+  (String -> Ptr b -> IO ()) ->+  IO (ConnectId obj)+connect_STRING_PTR__NONE signal after obj user =+  connectGeneric signal after obj action+  where action :: Ptr GObject -> CString -> Ptr () -> IO ()+        action _ str1 ptr2 =+          failOnGError $+          peekUTFString str1 >>= \str1' ->+          user str1' (castPtr ptr2)+
+ System/XFCE/Xfconf/Types.chs view
@@ -0,0 +1,85 @@+{-# OPTIONS_HADDOCK hide #-}+-- -*-haskell-*-+-- -------------------- automatically generated file - do not edit ----------+--  Object hierarchy for the GIMP Toolkit (GTK) Binding for Haskell+--+--  Author : Axel Simon+--+--  Copyright (C) 2001-2005 Axel Simon+--+--  This library is free software; you can redistribute it and/or+--  modify it under the terms of the GNU Lesser General Public+--  License as published by the Free Software Foundation; either+--  version 2.1 of the License, or (at your option) any later version.+--+--  This library is distributed in the hope that it will be useful,+--  but WITHOUT ANY WARRANTY; without even the implied warranty of+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU+--  Lesser General Public License for more details.+--+-- #hide++-- |+-- Maintainer  : gtk2hs-users@lists.sourceforge.net+-- Stability   : provisional+-- Portability : portable (depends on GHC)+--+-- This file reflects the Gtk+ object hierarchy in terms of Haskell classes.+--+-- Note: the mk... functions were originally meant to simply be an alias+-- for the constructor. However, in order to communicate the destructor+-- of an object to objectNew, the mk... functions are now a tuple containing+-- Haskell constructor and the destructor function pointer. This hack avoids+-- changing all modules that simply pass mk... to objectNew.+--+module System.XFCE.Xfconf.Types (++  XfconfChannel(XfconfChannel), XfconfChannelClass,+  toXfconfChannel, +  mkXfconfChannel, unXfconfChannel,+  castToXfconfChannel, gTypeXfconfChannel+  ) where++import Foreign.ForeignPtr (ForeignPtr, castForeignPtr, unsafeForeignPtrToPtr)+import Foreign.C.Types    (CULong, CUInt)+import System.Glib.GType	(GType, typeInstanceIsA)+import System.Glib.GObject++{# context lib="gtk" prefix="gtk" #}++-- The usage of foreignPtrToPtr should be safe as the evaluation will only be+-- forced if the object is used afterwards+--+castTo :: (GObjectClass obj, GObjectClass obj') => GType -> String+                                                -> (obj -> obj')+castTo gtype objTypeName obj =+  case toGObject obj of+    gobj@(GObject objFPtr)+      | typeInstanceIsA ((unsafeForeignPtrToPtr.castForeignPtr) objFPtr) gtype+                  -> unsafeCastGObject gobj+      | otherwise -> error $ "Cannot cast object to " ++ objTypeName+++-- ************************************************************** XfconfChannel++{#pointer *XfconfChannel foreign newtype #} deriving (Eq,Ord)++mkXfconfChannel = (XfconfChannel, objectUnref)+unXfconfChannel (XfconfChannel o) = o++class GObjectClass o => XfconfChannelClass o+toXfconfChannel :: XfconfChannelClass o => o -> XfconfChannel+toXfconfChannel = unsafeCastGObject . toGObject++instance XfconfChannelClass XfconfChannel+instance GObjectClass XfconfChannel where+  toGObject = GObject . castForeignPtr . unXfconfChannel+  unsafeCastGObject = XfconfChannel . castForeignPtr . unGObject++castToXfconfChannel :: GObjectClass obj => obj -> XfconfChannel+castToXfconfChannel = castTo gTypeXfconfChannel "XfconfChannel"++gTypeXfconfChannel :: GType+gTypeXfconfChannel =+  {# call fun unsafe xfconf_channel_get_type #}+
+ System/XFCE/Xfconf/Unsafe.chs view
@@ -0,0 +1,64 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}+-- vim:filetype=haskell:+--++-- XXX: Should we consider property names to be encoded in UTF-8 too+-- (string values are already encoded to / decoded from UTF-8).++{- | Legacy core functions from the C implementation.++   Before libxfconf can be use, it must be initialized by calling+   'xfconfInit'. To free resources used by the library, call+   'xfconfShutdown'. These calls are "recursive": multiple calls to+   'xfconfInit' are allowed, but each call must be matched by a+   separate call to 'xfconfShutdown' to really free the library's+   resources.++   For more information, see:+   http:\/\/docs.xfce.org\/api\/xfconf\/xfconf-xfconf.html+-}+++#include <xfconf/xfconf.h>++{# context lib="xfconf-0" prefix="xfconf" #}++module System.XFCE.Xfconf.Unsafe (+                xfconfInit,+                xfconfShutdown,+                ) where++import System.Glib.GError     (propagateGError)++import System.XFCE.Xfconf.FFI++{----------------------------------------------------------------------+-- Core+----------------------------------------------------------------------}++foreign import ccall unsafe "xfconf_init"+        c_xfconf_init :: Ptr (Ptr ()) -> IO ()++-- | Initializes the Xfconf library. Can be called multiple times with+-- no adverse effects.+--+-- May throw a 'GError'. You can try to catch it with:+--+-- @+--  catchGError xfconfInit+--              (\(GError d c m) -> do print d;print c;print m)+-- @+--+-- N.B.: most Haskell functions automatically calls xfconfInit when+-- needed. You should NOT directly use this function.+xfconfInit :: IO ()+xfconfInit = propagateGError (\errPtrPtr -> c_xfconf_init errPtrPtr)++-- | Shuts down and frees any resources consumed by the Xfconf library.+-- If 'xfconfInit' is called multiple times, 'xfconfShutdown' must be+-- called an equal number of times to shut down the library.+--+-- N.B.: most Haskell functions automatically calls xfconfShutdown when+-- needed. You should NOT directly use this function.+xfconfShutdown :: IO ()+xfconfShutdown = {#call unsafe xfconf_shutdown #}
+ System/XFCE/Xfconf/Values.chs view
@@ -0,0 +1,302 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}+-- we want to be able to write "instance Foobar String where"+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+-- we want to be able to write "instance Foobar String where"+-- ... and  "instance Foobar a => Foobar [a] where"+{-# LANGUAGE OverlappingInstances #-}++-- vim:filetype=haskell:+++{- This module provides generic 'XfconfValue' data types and specific+   GObject types used by the Xfconf daemon.++   For more information, see:+   http:\/\/docs.xfce.org\/api\/xfconf\/xfconf-xfconf-types.html+-}+++-- Gtk2hs ignore #include<foobar> instructions+-- I let them here, because they are pretty.+#include <glib.h>+#include <dbus/dbus-glib.h>+#include <xfconf/xfconf.h>++{# context lib="xfconf-0" prefix="xfconf" #}++module System.XFCE.Xfconf.Values (+        -- * Generic XfconfValue+        XfconfValue(..),+        XfconfValueClass(toXfconfValue),++        -- * Additional GValue type+        -- $additionalTypes+        int16,+        valueGetInt16,+        valueSetInt16,+        uint16,+        valueGetUInt16,+        valueSetUInt16,++        -- * Array hack+        -- $arrayHack+        array,+        allocaGValueArray+        ) where++import Control.Monad              (forM, forM_, replicateM)++import System.Glib.GType+{#import System.Glib.GValue #}+import System.Glib.GValueTypes+import System.Glib.GTypeConstants++import System.XFCE.Xfconf.FFI++data XfconfValue = XfconfString         String+                 | XfconfStringList     [String]+                 | XfconfInt            Int32+                 | XfconfUInt           Word32+                 | XfconfInt16          Int16+                 | XfconfUInt16         Word16+                 | XfconfUInt64         Word64+                 | XfconfDouble         Double+                 | XfconfBool           Bool+                 | XfconfArray          [XfconfValue]+                 | XfconfNotImplemented GType+                 deriving (Eq, Show)++class XfconfValueClass a where+        toXfconfValue :: a -> IO XfconfValue++instance XfconfValueClass XfconfValue where+        toXfconfValue = return . id++instance XfconfValueClass String where+        toXfconfValue = return . XfconfString++instance XfconfValueClass [String] where+        toXfconfValue = return . XfconfStringList++instance XfconfValueClass Int32 where+        toXfconfValue = return . XfconfInt++instance XfconfValueClass Word32 where+        toXfconfValue = return . XfconfUInt++instance XfconfValueClass Int16 where+        toXfconfValue = return . XfconfInt16++instance XfconfValueClass Word16 where+        toXfconfValue = return . XfconfUInt16++instance XfconfValueClass Word64 where+        toXfconfValue = return . XfconfUInt64++instance XfconfValueClass Double where+        toXfconfValue = return . XfconfDouble++instance XfconfValueClass Bool where+        toXfconfValue = return . XfconfBool++instance XfconfValueClass a => XfconfValueClass [a] where+        toXfconfValue xs = XfconfArray `fmap` (mapM toXfconfValue xs)++instance XfconfValueClass GValue where+ -- | Encapsulates a GValue in a XfconfValue+ toXfconfValue gvalue = valueGetType gvalue >>= getVal gvalue++   where getVal :: GValue -> GType -> IO XfconfValue+         getVal v t | t == bool   = XfconfBool `fmap` valueGetBool v+                    | t == int    = xInt `fmap` valueGetInt v+                    | t == int16  = xInt16 `fmap` valueGetInt16 v+                    | t == uint16 = xUInt16 `fmap` valueGetUInt16 v+                    | t == uint   = xUInt `fmap` valueGetUInt v+                    | t == uint64 = xUInt64 `fmap` valueGetUInt64 v+                    | t == double = XfconfDouble `fmap` valueGetDouble v+                    | t == string = XfconfString `fmap` valueGetString v+                    | t == array  = XfconfArray `fmap` xArray v+                    | otherwise   = return (XfconfNotImplemented t)++         xInt    = XfconfInt    . fromIntegral+         xUInt   = XfconfUInt   . fromIntegral+         xUInt64 = XfconfUInt64 . fromIntegral+         xUInt16 = XfconfUInt16 . fromIntegral+         xInt16  = XfconfInt16  . fromIntegral+         xArray  = arrayToXfconfValues++{----------------------------------------------------------------------+-- Additional types+----------------------------------------------------------------------}++-- $additionalTypes+-- libgobject lacks GObject fundamental types for 16-bit signed and+-- unsigned integers, which may be useful to use in an Xfconf store.+-- GObject types for these primitive types are provided here.+--+-- Note that, strangely, the xfconfd backend consider uint16 and int16+-- as, respectively, simple uint32 and int32. This Haskell FFI binding+-- hides this fact by converting uint32 and int32 back to uint16 and+-- int16 when using 'channelGetUInt16WithDefault' and+-- 'channelGetInt16WithDefault', but other frontends may behave+-- differently (notably the original C library or the+-- 'channelGetProperty' function).++{----------------------------------------------------------------------+-- gint16+----------------------------------------------------------------------}++int16 :: GType+int16 = unsafePerformIO $ {#call unsafe int16_get_type #}++foreign import ccall unsafe "xfconf.h xfconf_g_value_get_int16"+        c_get_int16 :: GValue -> IO CShort++valueGetInt16 :: GValue -> IO Int16+valueGetInt16 gvalue = fromIntegral `fmap` c_get_int16 gvalue++foreign import ccall unsafe "xfconf.h xfconf_g_value_set_int16"+        c_set_int16 :: GValue -> CShort -> IO ()++valueSetInt16 :: GValue -> Int16 -> IO ()+valueSetInt16 gvalue i = c_set_int16 gvalue (fromIntegral i)++{----------------------------------------------------------------------+-- guint16+----------------------------------------------------------------------}++uint16 :: GType+uint16 = unsafePerformIO $ {#call unsafe uint16_get_type #}++foreign import ccall unsafe "xfconf.h xfconf_g_value_get_uint16"+        c_get_uint16 :: GValue -> IO CUShort++valueGetUInt16 :: GValue -> IO Word16+valueGetUInt16 gvalue = fromIntegral `fmap` c_get_uint16 gvalue++foreign import ccall unsafe "xfconf.h xfconf_g_value_set_uint16"+        c_set_uint16 :: GValue -> CUShort -> IO ()++valueSetUInt16 :: GValue -> Word16 -> IO ()+valueSetUInt16 gvalue i = c_set_uint16 gvalue (fromIntegral i)++{----------------------------------------------------------------------+-- XFCONF Array hack+----------------------------------------------------------------------}++-- $arrayHack+-- xfconf code source defines in the directory @common/@ some hidden+-- functions. Among them, one can find helpers for array manipulation.++-- | From xfconf-common-private.h:+-- @+-- #define XFCONF_TYPE_G_VALUE_ARRAY  (dbus_g_type_get_collection(\"GPtrArray\", G_TYPE_VALUE))+-- @++array :: GType+array = unsafePerformIO $+        withCString "GPtrArray" $ \name -> do+        gtype <- {#call unsafe g_value_get_type #}+        {#call unsafe dbus_g_type_get_collection #} name gtype++-- | Read 'GValue's from a 'GPtrArray' of GValues+arrayToXfconfValues :: GValue -> IO [XfconfValue]+arrayToXfconfValues gvalue = do+        a <- {#call unsafe g_value_get_boxed #} gvalue+        size <- fromIntegral `fmap` {#get GPtrArray->len #} a+        if size == 0+          then return []+          -- From glib sources:+          -- #define    g_ptr_array_index(array,index_)+          --            ((array)->pdata)[index_]+          else gPtrArrayMapM (toXfconfValue . GValue) a size++-- | The big bro' of 'System.Glib.GValue.allocaGValue'.+-- This function works in three steps:+--+-- 1. Allocate memory for an array of 'XfconfValue' /not/ containing+-- complex elements such as 'XfconfStringList', 'XfconfArray' or+-- 'XfconfNotImplemented'+--+-- 2. perform the operation @(GValue -> IO b)@ where the 'GValue' is a+-- boxed value wrapping our array of 'GValue*'.+--+-- 3. free the memory.+--+allocaGValueArray :: [XfconfValue] -> (GValue -> IO b) -> IO b+allocaGValueArray xs action = do+        -- First and foremost, we do NOT handle complex xfconfvalues+        forM xs $ \x ->+           case x of+             XfconfArray _          -> error "cannot store XfconfArrays containing XfconfArray"+             XfconfStringList _     -> error "cannot store XfconfArrays containing XfconfStringList"+             XfconfNotImplemented _ -> error "cannot store XfconfArrays containing XfconftImplemented"+             _                      -> return ()++        gvalue <- xfconfArrayToGValue xs+        result <- action gvalue+        xfconfGValueArrayFree gvalue++        return result++  where len = length xs++        -- | Awful memory leak: malloc without free.+        -- Remember to free the memory later with 'xfconfGValueArrayFree'+        xfconfArrayToGValue xfvalues = do+                gPtrArray <- {#call unsafe g_ptr_array_sized_new #} (fromIntegral len)++                gvalues <- replicateM len (GValue `fmap` mallocGValue)++                forM_ (zip gvalues xfvalues) $ \(gvalue,xfvalue) -> do+                    case xfvalue of+                        XfconfInt     i -> valueInit gvalue int    >> valueSetInt    gvalue (fromIntegral i)+                        XfconfUInt    i -> valueInit gvalue uint   >> valueSetUInt   gvalue (fromIntegral i)+                        XfconfUInt64  i -> valueInit gvalue uint64 >> valueSetUInt64 gvalue i+                        XfconfDouble  d -> valueInit gvalue double >> valueSetDouble gvalue d+                        XfconfBool    b -> valueInit gvalue bool   >> valueSetBool   gvalue b+                        XfconfString  s -> valueInit gvalue string >> valueSetString gvalue s+                        XfconfInt16   i -> valueInit gvalue int16  >> valueSetInt16  gvalue i+                        XfconfUInt16  i -> valueInit gvalue uint16 >> valueSetUInt16 gvalue i+                        _               -> error "unknown XfconfValue type"++                forM gvalues $ \(GValue ptr) ->+                        {#call unsafe g_ptr_array_add #} gPtrArray (castPtr ptr)+++                ptrBox <- mallocGValue+                let gvBox = GValue ptrBox+                valueInit gvBox array+                {#call unsafe g_value_set_boxed#} gvBox gPtrArray++                return gvBox++          where mallocGValue :: IO (Ptr GValue)+                -- From glib-0.11.2/System/Glib/GValue.chs:+                -- c2hs is broken in that it can't handle arrays of compound arrays in the+                -- sizeof hook+                -- Correction: vanilla c2hs is fixed now, but your gtk2hsC2hs is still broken, so ...+                mallocGValue = do gvPtr <- mallocBytes ({# sizeof GType #} + 2* {# sizeof guint64 #})+                                  {# set GValue->g_type #} gvPtr (0 :: GType)+                                  return (castPtr gvPtr)+++        xfconfGValueArrayFree gvBox = do+                gPtrArray <- {#call unsafe g_value_get_boxed#} gvBox+                gPtrArrayMapM free gPtrArray len+                {#call unsafe g_ptr_array_free#} gPtrArray (fromBool True)+++-- | As 'Control.Monad.mapM', but for 'GPtrArray*'s+gPtrArrayMapM :: (Ptr GValue -> IO b) -- ^ function+              -> Ptr ()               -- ^ GPtrArray*+              -> Int                  -- ^ array size+              -> IO [b]               -- ^ results+gPtrArrayMapM f gPtrArray len = do+        -- From glib sources:+        -- #define    g_ptr_array_index(array,index_)+        --            ((array)->pdata)[index_]+        pdata <- {#get GPtrArray->pdata #} gPtrArray+        gvaluesPtr <- peekArray len (castPtr pdata :: Ptr (Ptr GValue))+        mapM f gvaluesPtr
+ Tests/TestGlib.hs view
@@ -0,0 +1,105 @@+module Main where++import Test.QuickCheck+import Test.QuickCheck.Monadic              as QCM+import Test.Framework                       (defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2++import Control.Concurrent.MVar+import Control.Concurrent                   (forkIO, threadDelay)+import Control.Exception                    (bracket_)++import System.XFCE.Xfconf+import System.Glib.MainLoop+import System.Glib.Signals                  (signalDisconnect)++sleep :: Int -> IO ()+sleep = threadDelay . (1000000*)++msleep :: Int -> IO ()+msleep = threadDelay . (1000*)++-- | garbage string, just be careful to avoid C-String delimiter ('\0')+genUTFString :: Gen String+genUTFString = suchThat arbitrary (notElem '\0')++-- | same as above but without empty strings+genUTFString1 :: Gen String+genUTFString1 = suchThat genUTFString (not . null)++testSignal :: Property+testSignal = monadicIO $ do+        value  <- pick genUTFString1+        value' <- QCM.run $ setAndRetrieveWithGlib value+        QCM.assert (value == value')++debugInOut n = bracket_ (putStrLn i) (putStrLn o)+  where i = "inside " ++ n+        o = "outside " ++ n++setAndRetrieveWithGlib :: String -> IO String+setAndRetrieveWithGlib value = do+        if null value+           then error "rondedjiu, beware the deadlocks \+                      \with your empty strings!"+           else return ()++        let chanName = "QuickCheck"+            propName = "/SignalCheck"++        chan   <- channelGet chanName+        result <- newEmptyMVar++        -- Init property to a dummy value, since xfconfd will only+        -- trigger the callback if our future new value is different+        -- from the present one+        debugInOut "setDummyString" $ channelSetString chan propName "init"++        -- we sleep, otherwise our previous "set" action might get+        -- caught by the following signal handler+        debugInOut "sleep(1)" $ msleep 40++        -- We set our signal handler. Note that the glib loop has been+        -- forked away from this process so the following operation will+        -- be processed apart.+        sigid <- onPropertyChanged chan $ \_ maybeValue -> debugInOut "onPropertyChanged" $ do+            cond <- isEmptyMVar result+            if cond+               then case maybeValue of+                 Just (XfconfString s) -> putMVar result s+                 Nothing               -> putMVar result ""+                 _                     -> putMVar result "UNKNWOW value"+               else do putStrLn "DANGER, WILL ROBINSON !"+                       error "you are going to fast !"+++        debugInOut "sleep(2)" $ msleep 40++        -- We resume our main thread here, by trigerring the previous+        -- signal (that what we were testing, remember ?)+        debugInOut "setNewString" $ channelSetString chan propName value++        -- ... and wait for the answer from the glib loop+        maybeValue' <- tryTakeMVar result++        -- pseudo process cleaning+        signalDisconnect sigid++        maybe (return "N/A") return maybeValue'+        --return value' -- return value' to QuickCheck.Monadic++main =  do+    loop <- mainLoopNew Nothing True+    debugInOut "fork" $ forkIO $ mainLoopRun loop+    msleep 100 >> setAndRetrieveWithGlib "foo" >>= putStr+    msleep 500 >> mainLoopQuit loop++main :: IO ()+main' = do+    loop <- mainLoopNew Nothing True+    forkIO $ mainLoopRun loop+    defaultMain testSuite >> mainLoopQuit loop++  where testSuite = [ testGroup "GLib loop"+                        [testProperty "onPropertyChanged" testSignal]+                    ]
+ Tests/Tests.hs view
@@ -0,0 +1,270 @@+{-| some tests you can run with `runghc -lxfconf-0 Tests/Tests` -}+-- A rewrite of the previous tests using monadic quickcheck++module Main where++import Test.Framework                       (defaultMain, testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2+import Test.HUnit++import Test.QuickCheck+import Test.QuickCheck.Monadic              as QCM++import Control.Concurrent                   (threadDelay)+import Data.Char                            (toLower)+import Text.Printf++import System.XFCE.Xfconf++myChannel = "QuickCheck"++main :: IO ()+main = defaultMain testSuite++  -- we need to sleep because garbace collection must collect objects+  -- before we shutdown xfconf (!! this sucks !!)+  where msleep = threadDelay . (1000*)++testSuitv = [ testGroup "Debugging"+                    [ testStringList+                    ]+            ]++testSuite = [ testGroup "QuickCheck"+                    [ testChannelPropertyBase+                    , testXfconfValue+                    , testXfconfArray+                    , testStringList+                    , testStringArray+                    , testString+                    , testDouble+                    , testInt+                    , testUInt+                    , testInt16+                    , testUInt16+                    , testUInt64+                    , testBool+                    ]+            , testGroup "HUnit"+                    [ testChannels+                    , testHasProperty+                    , testPropertyLocked+                    , testGetKeys+                    , testGetProperties+                    , testResetProperties+                    , testChannelName+                    ]+            ]++-- | Really dumb test+testChannels = testCase "xfconf_list_channels" $ do+        putStrLn "  Available channels:"++        xfconfListChannels >>= printStringArray++        assertBool "Query list of channels" True++testHasProperty = testCase "xfconf_channel_has_property" $ do+        chan  <- channelGet "xfce4-desktop"+        dummy <- channelHasProperty chan "/no/property"+        img   <- channelHasProperty chan "/backdrop/screen0/monitor0/image-path"++        assertBool "Non-existing property" (dummy == False)+        assertBool "Existing property" (img == True)++testPropertyLocked = testCase "xfconf_channel_is_property_locked" $ do+        chan  <- channelGet "xsettings"+        value <- channelIsPropertyLocked chan "/Net/ThemeName"++        assertBool "Property should not be locked" (value == False)++testResetProperties = testCase "xfconf_channel_reset_property" $ do+        chan  <- channelGet "QuickCheck"+        channelResetProperty chan "/" True+        alist <- chan `channelGetProperties` "/"++        assertBool "Channel not empty" (null alist)++testChannelName = testCase "channel attribute name" $ do+        let name = myChannel+        name'   <- channelGetName =<< channelGet name+        name''  <- channelGetName =<< channelNew name+        name''' <- channelGetName =<< channelNewWithPropertyBase name "/foo"++        assertBool "channelGet name"                 (name === name')+        assertBool "channelNew name"                 (name === name'')+        assertBool "channelNewWithPropertyBase name" (name === name''')++  where s === s' = lower s == lower s'+        lower = map toLower+++{----------------------------------------------------------------------+-- Serious business goes here+-- (well, it was serious because I had to implement GHashTable bindings)+----------------------------------------------------------------------}++testGetKeys =+  testCase "listing keys from a GHashTable" $ do+        putStrLn "  xfce4-desktop keys list:"++        desktop <- channelGet "xfce4-desktop"+        channelGetKeys desktop "/" >>= printStringArray++        assertBool "Query list of channel keys" True++testGetProperties =+  testCase "listing properties from a GHashTable" $ do+        putStrLn "  QuickCheck properties list:"++        desktop <- channelGet "QuickCheck"+        channelGetProperties desktop "/" >>= printTuples++        assertBool "Query list of channel properties" True+++{----------------------------------------------------------------------+-- QuickCheck.v2+----------------------------------------------------------------------}++testChannelPropertyBase =+  testProperty "channel attribute property base" $ monadicIO $ do+          base  <- pick genAsciiString+          chan  <- QCM.run $ channelNewWithPropertyBase myChannel base+          base' <- QCM.run $ channelGetPropertyBase chan++          QCM.assert (base' == base)++-- | garbage string, just be careful to avoid C-String delimiter ('\0')+genUTFString :: Gen String+genUTFString = suchThat arbitrary (notElem '\0')++genAsciiString :: Gen String+genAsciiString = listOf1 (elements ascii)+  where ascii = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ " \t"++-- Warnings:+--+-- XfconfStringList [String] are returned as+-- XfconfArray [XfconfString s]+--+-- (U)Int16 are returned as plain (U)Int by xfconfd+genBasicXfconfValue :: Gen XfconfValue+genBasicXfconfValue = oneof [ XfconfString `fmap` genUTFString+                            , XfconfInt    `fmap` arbitrary+                            , XfconfUInt   `fmap` arbitrarySizedIntegral+                            , XfconfUInt64 `fmap` arbitrarySizedIntegral+                            , XfconfDouble `fmap` arbitrary+                            , XfconfBool   `fmap` arbitrary+                            ]++testXfconfValue = testValue "XfconfValue"+                            -- setProperty Nothing is cursed by the+                            -- monomorphism restriction+                            (Just `fmap` genBasicXfconfValue)+                            channelGetProperty+                            channelSetProperty+testXfconfArray = testValue "XfconfArray"+                            (listOf genBasicXfconfValue)+                            channelGetArray+                            channelSetArray+testStringArray = testValue "StringArray"+                            (listOf genUTFString)+                            channelGetStringArray+                            channelSetStringList+  -- We will re-use our 'testValue' function but since it expect the Get+  -- and Set operator to work with the same type, we provide an hackish+  -- function to convert an XfconfArray [XfconfString] to [String]+  where channelGetStringArray :: XfconfChannel -> String -> IO [String]+        channelGetStringArray ch prop = do+           r <- channelGetProperty ch prop+           case r of+                Just (XfconfArray v) -> return (map fromXfconfString v)+                Nothing -> return []+                _       -> error "internal error"++        fromXfconfString (XfconfString s) = s+        fromXfconfString _                = error "expect XfconfString"++testStringList  = testValue "StringList"+                            (listOf genUTFString)+                            channelGetStringList+                            channelSetStringList+testString      = testValue "String"+                            genUTFString+                            channelGetString+                            channelSetString+testDouble      = testValue "Double"+                            arbitrary+                            channelGetDouble+                            channelSetDouble+testInt         = testValue "Int"+                            arbitrary+                            channelGetInt+                            channelSetInt+testUInt        = testValue "UInt"+                            arbitrarySizedIntegral+                            channelGetUInt+                            channelSetUInt+testInt16       = testValue "Int16"+                            arbitrarySizedIntegral+                            channelGetInt16+                            channelSetInt16+testUInt16      = testValue "UInt16"+                            arbitrarySizedIntegral+                            channelGetUInt16+                            channelSetUInt16+testUInt64      = testValue "UInt64"+                            arbitrarySizedIntegral+                            channelGetUInt64+                            channelSetUInt64+testBool        = testValue "Bool"+                            arbitrary+                            channelGetBool+                            channelSetBool++-- | Check generic read and write operations+testValue typeName gen getOp setOp =+  testProperty testName $ QCM.monadicIO $ do++        value  <- QCM.pick gen+        value' <- QCM.run $ computeNewValue value+        QCM.assert (value == value')++  where testName = "xfconf_channel_get/set " ++ typeName+        computeNewValue v= do+                -- we use the name of the type as xfconf property name+                let prop = "/" ++ typeName+                channel <- channelGet myChannel++                -- apply dummy test value+                setOp channel prop v+                -- Query xfconfd back+                getOp channel prop+++manualTestProperty setOp getOp value = do+    channel <- channelGet myChannel+    setOp channel prop value+    value' <- getOp channel prop+    let same = (value == value')+    if same+       then printf "Ok\n"+       else printf "(value,value') = (%s, %s)\n" (show value) (show value')++  where prop = "/Manual"++{----------------------------------------------------------------------+-- Utilities+----------------------------------------------------------------------}++-- | Pretty print function because I am getting bored watching tests+-- output+printStringArray :: [String] -> IO ()+printStringArray xs = mapM_ (\x -> putStrLn ("    " ++ show x)) xs++printTuples :: [(String, Maybe XfconfValue)] -> IO ()+printTuples xs = mapM_ fmt xs+  where fmt (k,v) = putStrLn $ "    " ++ k ++ ": " ++ show v+
+ hierarchy.list view
@@ -0,0 +1,20 @@+# This list is the result of a copy-and-paste from the GtkObject hierarchy+# html documentation. Deprecated widgets are uncommented. Some additional+# object have been defined at the end of the copied list.++# The Gtk prefix of every object is removed, the other prefixes are+# kept.  The indentation implies the object hierarchy. In case the+# type query function cannot be derived from the name or the type name+# is different, an alternative name and type query function can be+# specified by appending 'as typename, <query_func>'.  In case this+# function is not specified, the <name> is converted to+# gtk_<name'>_get_type where <name'> is <name> where each upperscore+# letter is converted to an underscore and lowerletter. The underscore+# is omitted if an upperscore letter preceeded: GtkHButtonBox ->+# gtk_hbutton_box_get_type. The generation of a type can be+# conditional by appending 'if <tag>'. Such types are only produces if+# --tag=<tag> is given on the command line of TypeGenerator.+++    GObject +		XfconfChannel		as XfconfChannel if xfconf
+ include/all.h view
@@ -0,0 +1,2 @@+#include <xfconf/xfconf.h>+#include <dbus/dbus-glib.h>
+ include/xfconf-binding.h view
@@ -0,0 +1,54 @@+/*+ *  xfconf+ *+ *  Copyright (c) 2008 Brian Tarricone <bjt23@cornell.edu>+ *+ *  This program is free software; you can redistribute it and/or modify+ *  it under the terms of the GNU General Public License as published by+ *  the Free Software Foundation; version 2 of the License ONLY.+ *+ *  This program is distributed in the hope that it will be useful,+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+ *  GNU General Public License for more details.+ *+ *  You should have received a copy of the GNU General Public License+ *  along with this program; if not, write to the Free Software+ *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA+ */++#ifndef __XFCONF_BINDING_H__+#define __XFCONF_BINDING_H__++#if !defined(LIBXFCONF_COMPILATION) && !defined(XFCONF_IN_XFCONF_H)+#error "Do not include xfconf-binding.h, as this file may change or disappear in the future.  Include <xfconf/xfconf.h> instead."+#endif++#include <glib-object.h>+#include <xfconf/xfconf-channel.h>++G_BEGIN_DECLS++gulong xfconf_g_property_bind(XfconfChannel *channel,+                              const gchar *xfconf_property,+                              GType xfconf_property_type,+                              gpointer object,+                              const gchar *object_property);++gulong xfconf_g_property_bind_gdkcolor(XfconfChannel *channel,+                                       const gchar *xfconf_property,+                                       gpointer object,+                                       const gchar *object_property);++void xfconf_g_property_unbind(gulong id);++void xfconf_g_property_unbind_by_property(XfconfChannel *channel,+                                          const gchar *xfconf_property,+                                          gpointer object,+                                          const gchar *object_property);++void xfconf_g_property_unbind_all(gpointer channel_or_object);++G_END_DECLS++#endif  /* __XFCONF_BINDING_H__ */
+ include/xfconf-channel.h view
@@ -0,0 +1,204 @@+/*+ *  xfconf+ *+ *  Copyright (c) 2007-2008 Brian Tarricone <bjt23@cornell.edu>+ *+ *  This program is free software; you can redistribute it and/or modify+ *  it under the terms of the GNU General Public License as published by+ *  the Free Software Foundation; version 2 of the License ONLY.+ *+ *  This program is distributed in the hope that it will be useful,+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+ *  GNU General Public License for more details.+ *+ *  You should have received a copy of the GNU General Public License+ *  along with this program; if not, write to the Free Software+ *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA+ */++#ifndef __XFCONF_CHANNEL_H__+#define __XFCONF_CHANNEL_H__++#if !defined(LIBXFCONF_COMPILATION) && !defined(XFCONF_IN_XFCONF_H)+#error "Do not include xfconf-channel.h, as this file may change or disappear in the future.  Include <xfconf/xfconf.h> instead."+#endif++#include <glib-object.h>++#define XFCONF_TYPE_CHANNEL             (xfconf_channel_get_type())+#define XFCONF_CHANNEL(obj)             (G_TYPE_CHECK_INSTANCE_CAST((obj), XFCONF_TYPE_CHANNEL, XfconfChannel))+#define XFCONF_IS_CHANNEL(obj)          (G_TYPE_CHECK_INSTANCE_TYPE((obj), XFCONF_TYPE_CHANNEL))+#define XFCONF_CHANNEL_CLASS(klass)     (G_TYPE_CHECK_CLASS_CAST((klass), XFCONF_TYPE_CHANNEL, XfconfChannelClass))+#define XFCONF_IS_CHANNEL_CLASS(klass)  (G_TYPE_CHECK_CLASS_TYPE((klass), XFCONF_TYPE_CHANNEL))+#define XFCONF_CHANNEL_GET_CLASS(obj)   (G_TYPE_INSTANCE_GET_CLASS((obj), XFCONF_TYPE_CHANNEL, XfconfChannelClass))++G_BEGIN_DECLS++typedef struct _XfconfChannel         XfconfChannel;++GType xfconf_channel_get_type() G_GNUC_CONST;++XfconfChannel *xfconf_channel_get(const gchar *channel_name);++XfconfChannel *xfconf_channel_new(const gchar *channel_name) G_GNUC_WARN_UNUSED_RESULT;++XfconfChannel *xfconf_channel_new_with_property_base(const gchar *channel_name,+                                                     const gchar *property_base) G_GNUC_WARN_UNUSED_RESULT;++gboolean xfconf_channel_has_property(XfconfChannel *channel,+                                     const gchar *property);++gboolean xfconf_channel_is_property_locked(XfconfChannel *channel,+                                           const gchar *property);++void xfconf_channel_reset_property(XfconfChannel *channel,+                                   const gchar *property_base,+                                   gboolean recursive);++GHashTable *xfconf_channel_get_properties(XfconfChannel *channel,+                                          const gchar *property_base) G_GNUC_WARN_UNUSED_RESULT;++/* basic types */++gchar *xfconf_channel_get_string(XfconfChannel *channel,+                                 const gchar *property,+                                 const gchar *default_value) G_GNUC_WARN_UNUSED_RESULT;+gboolean xfconf_channel_set_string(XfconfChannel *channel,+                                   const gchar *property,+                                   const gchar *value);++gint32 xfconf_channel_get_int(XfconfChannel *channel,+                              const gchar *property,+                              gint32 default_value);+gboolean xfconf_channel_set_int(XfconfChannel *channel,+                                const gchar *property,+                                gint32 value);++guint32 xfconf_channel_get_uint(XfconfChannel *channel,+                                const gchar *property,+                                guint32 default_value);+gboolean xfconf_channel_set_uint(XfconfChannel *channel,+                                 const gchar *property,+                                 guint32 value);++guint64 xfconf_channel_get_uint64(XfconfChannel *channel,+                                  const gchar *property,+                                  guint64 default_value);+gboolean xfconf_channel_set_uint64(XfconfChannel *channel,+                                   const gchar *property,+                                   guint64 value);++gdouble xfconf_channel_get_double(XfconfChannel *channel,+                                  const gchar *property,+                                  gdouble default_value);+gboolean xfconf_channel_set_double(XfconfChannel *channel,+                                   const gchar *property,+                                   gdouble value);++gboolean xfconf_channel_get_bool(XfconfChannel *channel,+                                 const gchar *property,+                                 gboolean default_value);+gboolean xfconf_channel_set_bool(XfconfChannel *channel,+                                 const gchar *property,+                                 gboolean value);++/* this is just convenience API for the array stuff, where+ * all the values are G_TYPE_STRING */+gchar **xfconf_channel_get_string_list(XfconfChannel *channel,+                                       const gchar *property) G_GNUC_WARN_UNUSED_RESULT;+gboolean xfconf_channel_set_string_list(XfconfChannel *channel,+                                        const gchar *property,+                                        const gchar * const *values);++/* really generic API - can set some value types that aren't+ * supported by the basic type API, e.g., char, signed short,+ * unsigned int, etc.  no, you can't set arbitrary GTypes. */+gboolean xfconf_channel_get_property(XfconfChannel *channel,+                                     const gchar *property,+                                     GValue *value);+gboolean xfconf_channel_set_property(XfconfChannel *channel,+                                     const gchar *property,+                                     const GValue *value);++/* array types - arrays can be made up of values of arbitrary+ * (and mixed) types, even some not supported by the basic+ * type API */++gboolean xfconf_channel_get_array(XfconfChannel *channel,+                                  const gchar *property,+                                  GType first_value_type,+                                  ...);+gboolean xfconf_channel_get_array_valist(XfconfChannel *channel,+                                         const gchar *property,+                                         GType first_value_type,+                                         va_list var_args);+GPtrArray *xfconf_channel_get_arrayv(XfconfChannel *channel,+                                     const gchar *property) G_GNUC_WARN_UNUSED_RESULT;++gboolean xfconf_channel_set_array(XfconfChannel *channel,+                                  const gchar *property,+                                  GType first_value_type,+                                  ...);+gboolean xfconf_channel_set_array_valist(XfconfChannel *channel,+                                         const gchar *property,+                                         GType first_value_type,+                                         va_list var_args);+gboolean xfconf_channel_set_arrayv(XfconfChannel *channel,+                                   const gchar *property,+                                   GPtrArray *values);++/* struct types */++gboolean xfconf_channel_get_named_struct(XfconfChannel *channel,+                                         const gchar *property,+                                         const gchar *struct_name,+                                         gpointer value_struct);+gboolean xfconf_channel_set_named_struct(XfconfChannel *channel,+                                         const gchar *property,+                                         const gchar *struct_name,+                                         gpointer value_struct);++gboolean xfconf_channel_get_struct(XfconfChannel *channel,+                                   const gchar *property,+                                   gpointer value_struct,+                                   GType first_member_type,+                                   ...);+gboolean xfconf_channel_get_struct_valist(XfconfChannel *channel,+                                          const gchar *property,+                                          gpointer value_struct,+                                          GType first_member_type,+                                          va_list var_args);+gboolean xfconf_channel_get_structv(XfconfChannel *channel,+                                    const gchar *property,+                                    gpointer value_struct,+                                    guint n_members,+                                    GType *member_types);++gboolean xfconf_channel_set_struct(XfconfChannel *channel,+                                   const gchar *property,+                                   const gpointer value_struct,+                                   GType first_member_type,+                                   ...);+gboolean xfconf_channel_set_struct_valist(XfconfChannel *channel,+                                          const gchar *property,+                                          const gpointer value_struct,+                                          GType first_member_type,+                                          va_list var_args);+gboolean xfconf_channel_set_structv(XfconfChannel *channel,+                                    const gchar *property,+                                    const gpointer value_struct,+                                    guint n_members,+                                    GType *member_types);++#if 0  /* future (maybe) */++//gboolean xfconf_channel_begin_transaction(XfconfChannel *channel);+//gboolean xfconf_channel_commit_transaction(XfconfChannel *channel);+//void xfconf_channel_cancel_transaction(XfconfChannel *channel);++#endif++G_END_DECLS++#endif  /* __XFCONF_CHANNEL_H__ */
+ include/xfconf-errors.h view
@@ -0,0 +1,53 @@+/*+ *  xfconf+ *+ *  Copyright (c) 2007 Brian Tarricone <bjt23@cornell.edu>+ *+ *  This program is free software; you can redistribute it and/or modify+ *  it under the terms of the GNU General Public License as published by+ *  the Free Software Foundation; version 2 of the License ONLY.+ *+ *  This program is distributed in the hope that it will be useful,+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+ *  GNU Library General Public License for more details.+ *+ *  You should have received a copy of the GNU General Public License+ *  along with this program; if not, write to the Free Software+ *  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+ */++#ifndef __XFCONF_ERRORS_H__+#define __XFCONF_ERRORS_H__++#if !defined(LIBXFCONF_COMPILATION) && !defined(XFCONF_IN_XFCONF_H)+#error "Do not include xfconf-errors.h, as this file may change or disappear in the future.  Include <xfconf/xfconf.h> instead."+#endif++#include <glib-object.h>++#define XFCONF_TYPE_ERROR  (xfconf_error_get_type())+#define XFCONF_ERROR       (xfconf_get_error_quark())++G_BEGIN_DECLS++typedef enum+{+    XFCONF_ERROR_UNKNOWN = 0,+    XFCONF_ERROR_CHANNEL_NOT_FOUND,+    XFCONF_ERROR_PROPERTY_NOT_FOUND,+    XFCONF_ERROR_READ_FAILURE,+    XFCONF_ERROR_WRITE_FAILURE,+    XFCONF_ERROR_PERMISSION_DENIED,+    XFCONF_ERROR_INTERNAL_ERROR,+    XFCONF_ERROR_NO_BACKEND,+    XFCONF_ERROR_INVALID_PROPERTY,+    XFCONF_ERROR_INVALID_CHANNEL,+} XfconfError;++GType xfconf_error_get_type() G_GNUC_CONST;+GQuark xfconf_get_error_quark();++G_END_DECLS++#endif  /* __XFCONF_ERRORS_H__ */
+ include/xfconf-types.h view
@@ -0,0 +1,48 @@+/*+ *  xfconf+ *+ *  Copyright (c) 2007 Brian Tarricone <bjt23@cornell.edu>+ *+ *  This program is free software; you can redistribute it and/or modify+ *  it under the terms of the GNU General Public License as published by+ *  the Free Software Foundation; version 2 of the License ONLY.+ *+ *  This program is distributed in the hope that it will be useful,+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+ *  GNU Library General Public License for more details.+ *+ *  You should have received a copy of the GNU General Public License+ *  along with this program; if not, write to the Free Software+ *  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+ */++#ifndef __XFCONF_TYPES_H__+#define __XFCONF_TYPES_H__++#if !defined(LIBXFCONF_COMPILATION) && !defined(XFCONF_IN_XFCONF_H)+#error "Do not include xfconf-types.h, as this file may change or disappear in the future.  Include <xfconf/xfconf.h> instead."+#endif++#include <glib-object.h>++#define XFCONF_TYPE_UINT16  (xfconf_uint16_get_type())+#define XFCONF_TYPE_INT16   (xfconf_int16_get_type())++G_BEGIN_DECLS++GType xfconf_uint16_get_type() G_GNUC_CONST;++guint16 xfconf_g_value_get_uint16(const GValue *value);+void xfconf_g_value_set_uint16(GValue *value,+                               guint16 v_uint16);++GType xfconf_int16_get_type() G_GNUC_CONST;++gint16 xfconf_g_value_get_int16(const GValue *value);+void xfconf_g_value_set_int16(GValue *value,+                              gint16 v_int16);++G_END_DECLS++#endif
+ include/xfconf.h view
@@ -0,0 +1,49 @@+/*+ *  xfconf+ *+ *  Copyright (c) 2007 Brian Tarricone <bjt23@cornell.edu>+ *+ *  This program is free software; you can redistribute it and/or modify+ *  it under the terms of the GNU General Public License as published by+ *  the Free Software Foundation; version 2 of the License ONLY.+ *+ *  This program is distributed in the hope that it will be useful,+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+ *  GNU Library General Public License for more details.+ *+ *  You should have received a copy of the GNU General Public License+ *  along with this program; if not, write to the Free Software+ *  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+ */++#ifndef __XFCONF_H__+#define __XFCONF_H__++#include <glib.h>++#define XFCONF_IN_XFCONF_H++#include <xfconf/xfconf-channel.h>+#include <xfconf/xfconf-binding.h>+#include <xfconf/xfconf-errors.h>+#include <xfconf/xfconf-types.h>++#undef XFCONF_IN_XFCONF_H++G_BEGIN_DECLS++gboolean xfconf_init(GError **error);+void xfconf_shutdown();++void xfconf_named_struct_register(const gchar *struct_name,+                                  guint n_members,+                                  const GType *member_types);++void xfconf_array_free(GPtrArray *arr);++gchar **xfconf_list_channels() G_GNUC_WARN_UNUSED_RESULT;++G_END_DECLS++#endif  /* __XFCONF_H__ */
+ marshal.list view
@@ -0,0 +1,45 @@+# see glib-genmarshal(1) for a detailed description of the file format,+# possible parameter types are:+#   VOID        indicates   no   return   type,  or  no  extra+#               parameters. if VOID is used as  the  parameter+#               list, no additional parameters may be present.+#   BOOLEAN     for boolean types (gboolean)+#   CHAR        for signed char types (gchar)+#   UCHAR       for unsigned char types (guchar)+#   INT         for signed integer types (gint)+#   UINT        for unsigned integer types (guint)+#   LONG        for signed long integer types (glong)+#   ULONG       for unsigned long integer types (gulong)+#   ENUM        for enumeration types (gint)+#   FLAGS       for flag enumeration types (guint)+#   FLOAT       for single-precision float types (gfloat)+#   DOUBLE      for double-precision float types (gdouble)+#   STRING      for string types (gchar*)+#   BOXED       for boxed (anonymous but reference counted) types (GBoxed*)+#   POINTER     for anonymous pointer types (gpointer)+#   NONE        deprecated alias for VOID+#   BOOL        deprecated alias for BOOLEAN++#+# One discrepancy from Gtk+ is that for signals that may pass NULL for an object+# reference, the Haskell signal should be passed a 'Maybe GObject'.+# We therefore have two variants that are marshalled as a maybe type:+#+#   OBJECT      for GObject or derived types (GObject*)+#   MOBJECT      for GObject or derived types (GObject*) that may be NULL++# Furthermore, some objects needs to be destroyed synchronously from the main loop of+# Gtk rather than during GC. These objects need to be marshalled using TOBJECT (for thread-safe+# object). It doesn't hurt to use TOBJECT for an object that doesn't need it, except for the+# some performance. As a rule of thumb, use TOBJECT for all libraries that build on package+# 'gtk' and use OBJECT for all packages that only need packages 'glib', 'pango', 'cairo',+# 'gio'. Again both variants exist. Note that the same names will be generated for OBJECT and+# TOBJECT, so you have to remove the OBJECT handler if you need both.+#+#   TOBJECT      for GObject or derived types (GObject*)+#   MTOBJECT      for GObject or derived types (GObject*) that may be NULL++# If you add a new signal type, please check that it actually works!+# If it is a Boxed type check that the reference counting is right.++NONE:STRING,POINTER
+ xfconf.cabal view
@@ -0,0 +1,165 @@+-- auto-generated by cabal init. For additional options, see:+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.++Name:                xfconf+Version:             4.8.0.0+Stability:           alpha+Synopsis:            FFI bindings to xfconf+Description:+    Xfconf is a simple client-server configuration storage and query+	system build on top of glib and used by XFCE.+Homepage:            http://patch-tag.com/r/obbele/xfconf/home+License:             GPL-3+License-file:        LICENSE+Author:              John Obbele+Maintainer:          john.obbele@gmail.com+Category:            System, XFCE+Build-type:          Custom+Cabal-version:       >=1.6++Extra-Source-Files:  Gtk2HsSetup.hs marshal.list hierarchy.list+Extra-source-files:  Makefile README++-- Demo program.+Extra-source-files:  Demo/Demo.hs++-- Some examples of native C xfconf.+Extra-source-files:  C/demo.c C/Makefile++-- Header files for reference.+Extra-source-files:  include/xfconf-binding.h include/xfconf-channel.h+Extra-source-files:  include/xfconf-errors.h include/xfconf.h+Extra-source-files:  include/xfconf-types.h++-- Header files forcing gtk2hsC2hs to include multiple headers.+Extra-source-files:  include/all.h++-- Gtk2HS black magic.+x-Types-File:       System/XFCE/Xfconf/Types.chs+x-Types-ModName:    System.XFCE.Xfconf.Types+x-Types-Import:     System.Glib.GObject+x-Types-Tag:        xfconf+x-Types-Hierarchy:  hierarchy.list++Source-Repository head+  type:              darcs+  location:          http://patch-tag.com/r/obbele/xfconf/home++Flag buildTests+  description:       Build the two test suites+  default:           False++library+  -- Be a good child and build modules in the following order+  -- to avoid dependencies misfortunes.+  Exposed-Modules:   System.XFCE.Xfconf.Unsafe+                     System.XFCE.Xfconf.Core+                     System.XFCE.Xfconf.Error+                     System.XFCE.Xfconf.Values+                     -- Channel requires those normally hidden packages+                     System.XFCE.Xfconf.GHashTable+                     System.XFCE.Xfconf.Types+                     System.XFCE.Xfconf.Signals+                     --+                     System.XFCE.Xfconf.Channel+                     -- Binding requires Channel+                     System.XFCE.Xfconf.Binding+                     -- … and in the darkness bind them+                     System.XFCE.Xfconf++  Other-Modules:     System.XFCE.Xfconf.FFI++  Build-depends:     base                       >=3.0 && < 5.0,+                     glib                       >=0.12++ -- dependencies specific to Tests/Tests+  if flag(buildTests)+      Build-depends: test-framework             ==0.3.*,+                     test-framework-hunit       ==0.2.*,+                     test-framework-quickcheck2 ==0.2.*,+                     HUnit                      ==1.2.*,+                     QuickCheck                 >=2.1++  build-tools:       gtk2hsC2hs, gtk2hsHookGenerator, gtk2hsTypeGen++  x-Signals-File:    System/XFCE/Xfconf/Signals.chs+  x-Signals-Modname: System.XFCE.Xfconf.Signals+  x-Signals-Types:   marshal.list+  x-c2hs-Header:     include/all.h+  -- needed by Types.chs+  extensions:        ForeignFunctionInterface++  pkgconfig-depends: libxfconf-0++  ghc-options:       -Wall -fno-warn-unused-do-bind++Executable tests+  Main-is:           Tests/Tests.hs++  if flag(buildTests)+      Buildable:     True+  else+      Buildable:     False++  ghc-options:       -Wall+  ghc-options:       -fno-warn-unused-do-bind+  ghc-options:       -fno-warn-missing-signatures+  ghc-options:       -auto-all++  -- Copy-and-paste instructions from the previous library target.+  build-tools:       gtk2hsC2hs, gtk2hsHookGenerator, gtk2hsTypeGen+  x-Signals-File:    System/XFCE/Xfconf/Signals.chs+  x-Signals-Modname: System.XFCE.Xfconf.Signals+  x-Signals-Types:   marshal.list+  x-c2hs-Header:     include/all.h+  extensions:        ForeignFunctionInterface+  pkgconfig-depends: libxfconf-0+  -- Cabal refuses to build saying that System.XFCE.Xfconf.{FFI, ...}+  -- are hidden modules from the missing dependency "xfconf-0.0.0.x"+  -- For peace on earth we shall declare all our previous modules+  -- in the following "Other-Modules" attributes+  Other-Modules:     System.XFCE.Xfconf.FFI+                     System.XFCE.Xfconf.Unsafe+                     System.XFCE.Xfconf.Core+                     System.XFCE.Xfconf.Error+                     System.XFCE.Xfconf.Values+                     System.XFCE.Xfconf.GHashTable+                     System.XFCE.Xfconf.Types+                     System.XFCE.Xfconf.Signals+                     System.XFCE.Xfconf.Channel+                     System.XFCE.Xfconf.Binding+                     System.XFCE.Xfconf++Executable testGlib+  Main-is:           Tests/TestGlib.hs++  if flag(buildTests)+      Buildable:     True+  else+      Buildable:     False++  ghc-options:       -Wall+  ghc-options:       -fno-warn-unused-do-bind+  ghc-options:       -fno-warn-missing-signatures+  ghc-options:       -threaded++  -- Copy-and-paste instructions from the previous library target.+  build-tools:       gtk2hsC2hs, gtk2hsHookGenerator, gtk2hsTypeGen+  x-Signals-File:    System/XFCE/Xfconf/Signals.chs+  x-Signals-Modname: System.XFCE.Xfconf.Signals+  x-Signals-Types:   marshal.list+  x-c2hs-Header:     include/all.h+  extensions:        ForeignFunctionInterface+  pkgconfig-depends: libxfconf-0+  Other-Modules:     System.XFCE.Xfconf.FFI+                     System.XFCE.Xfconf.Unsafe+                     System.XFCE.Xfconf.Core+                     System.XFCE.Xfconf.Error+                     System.XFCE.Xfconf.Values+                     System.XFCE.Xfconf.GHashTable+                     System.XFCE.Xfconf.Types+                     System.XFCE.Xfconf.Signals+                     System.XFCE.Xfconf.Channel+                     System.XFCE.Xfconf.Binding+                     System.XFCE.Xfconf+