Beispiel #1
0
/**
 * A general call.  Parameters are
 *  0: The LouDBusProxy
 *  1: The method name (string)
 *  others: Parameters to the method
 */
Scheme_Object *
loudbus_call (int argc, Scheme_Object **argv)
{
  LouDBusProxy *proxy;
  gchar *name;

  // I don't think that I need to add annotations for garbage collection
  // because scheme_object_to_string is the only allocating call, and we've
  // dealt with all the other Scheme objects by the time we call it.
  proxy = scheme_object_to_proxy (argv[0]);
  name = scheme_object_to_string (argv[1]);

  // Sanity checks
  if (proxy == NULL)
    {
      scheme_wrong_type ("loudbus-call", "LouDBusProxy *", 0, argc, argv);
    } // if we could not get the proxy
  if (name == NULL)
    {
      scheme_wrong_type ("loudbus-call", "string", 1, argc, argv);
    } // if we could not get the name

  // Permit the use of dashes
  score_it_all (name);

  return dbus_call_kernel (proxy, name, name, argc-2, argv+2);
} // loudbus_call
Beispiel #2
0
/**
 * Call a function, using the proxy, function name, and external name
 * stored in prim.
 *
 * argc/argv give the parameters for the function call.
 */
Scheme_Object *
loudbus_call_with_closure (int argc, Scheme_Object **argv, Scheme_Object *prim)
{
  Scheme_Object *wrapped_proxy = NULL;
  Scheme_Object *wrapped_dbus_name = NULL;
  Scheme_Object *wrapped_external_name = NULL;
  Scheme_Object *result = NULL;
  LouDBusProxy *proxy = NULL;
  gchar *dbus_name;
  gchar *external_name;

  // Probably too many things are annotated here, but better safe than
  // sorry.
  MZ_GC_DECL_REG (5);
  MZ_GC_VAR_IN_REG (0, argv);
  MZ_GC_VAR_IN_REG (1, prim);
  MZ_GC_VAR_IN_REG (2, wrapped_proxy);
  MZ_GC_VAR_IN_REG (3, wrapped_dbus_name);
  MZ_GC_VAR_IN_REG (4, wrapped_external_name);
  MZ_GC_REG ();

  // Extract information from the closure.
  wrapped_proxy = SCHEME_PRIM_CLOSURE_ELS (prim)[0];
  wrapped_dbus_name = SCHEME_PRIM_CLOSURE_ELS (prim)[1];
  wrapped_external_name = SCHEME_PRIM_CLOSURE_ELS (prim)[2];
  dbus_name = scheme_object_to_string (wrapped_dbus_name);
  external_name = scheme_object_to_string (wrapped_external_name);
  proxy = scheme_object_to_proxy (wrapped_proxy);

  // Sanity check
  if (proxy == NULL)
    {
      MZ_GC_UNREG ();
      scheme_signal_error ("Could not obtain proxy to call %s.\n",
                           external_name);
    } // if (proxy == NULL)
   
  // And do the dirty work
  result = dbus_call_kernel (proxy, 
                             dbus_name, external_name, 
                             argc, argv);

  MZ_GC_UNREG ();
  return result;
} // loudbus_call_with_closure
Beispiel #3
0
/**
 * Convert a Scheme object to a GVariant that will serve as one of
 * the parameters of a call go g_dbus_proxy_call_....  Returns NULL
 * if it is unable to do the conversion.
 */
static GVariant *
scheme_object_to_parameter (Scheme_Object *obj, gchar *type)
{
  gchar *str;           // A temporary string

  switch (type[0])
    {
      // Arrays
      case 'a':
        return scheme_object_to_array (obj, type);

      // Doubles
      case 'd':
        if (SCHEME_DBLP (obj))
          return g_variant_new ("d", SCHEME_DBL_VAL (obj));
        else if (SCHEME_FLTP (obj))
          return g_variant_new ("d", (double) SCHEME_FLT_VAL (obj));
        else if (SCHEME_INTP (obj))
          return g_variant_new ("d", (double) SCHEME_INT_VAL (obj));
        else
          return NULL;

      // 32 bit integers
      case 'i':
        if (SCHEME_INTP (obj))
          return g_variant_new ("i", (int) SCHEME_INT_VAL (obj));
        else if (SCHEME_DBLP (obj))
          return g_variant_new ("i", (int) SCHEME_DBL_VAL (obj));
        else 
          return NULL;

      // Strings
      case 's':
        str = scheme_object_to_string (obj);
        if (str == NULL)
          return NULL;
        return g_variant_new ("s", str);

      // 32 bit unsigned integers
      case 'u':
        if (SCHEME_INTP (obj))
          return g_variant_new ("u", (unsigned int) SCHEME_INT_VAL (obj));
        else
          return NULL;

      // Everything else is currently unsupported
      default:
        return NULL;
    } // switch
} // scheme_object_to_parameter
Beispiel #4
0
/**
 * Get a list of available objects.
 * TODO:
 *   1. Check that this works at all. (Nope.)
 *   2. Check that this gets the full path.  (Didn't we decide that
 *      you needed to recursively find elements?)
 *   3. Add error checking for the call to g_variant_to_scheme_result.
 *   4. Clean up after yourself.  You've created a proxy.  Get rid of
 *      it so it doesn't sit there clogging memory.  (See loudbus_proxy_free
 *      for details.)
 */
static Scheme_Object *
loudbus_objects (int argc, Scheme_Object **argv)
{
  GDBusProxy *proxy;            // Proxy for connecting to server
  GError *error;                // Potential error
  GVariant *params;             // Parameters to function call
  GVariant *result;             // Result of request for info
  gchar *service;               // Name of the service

  service = scheme_object_to_string (argv[0]);

  // Check parameter
  if (service == NULL)
    {
      scheme_wrong_type ("loudbus-proxy", "string", 0, argc, argv);
    } // if (service == NULL)
  
  // Create the proxy that we'll use to get information on the service.
  LOG ("Creatign proxy for %s", service);
  proxy = g_dbus_proxy_new_for_bus_sync (G_BUS_TYPE_SESSION,
                                         G_DBUS_PROXY_FLAGS_NONE,
                                         NULL,
                                         service,
                                         "",
                                         "",
                                         NULL,
                                         &error);

  // Call the function to get the objects.  (This looks wrong.)
  params = g_variant_new("()");
  result = g_dbus_proxy_call_sync (proxy,
                                    "",
                                    params,
                                    0,
                                    -1,
                                    NULL,
                                    &error);

  // Check the result.
  // TODO

  // And we're done.
  return g_variant_to_scheme_object (result);
} // loudbus_objects
Beispiel #5
0
/**
 * Convert a Scheme object to a GVariant that will serve as one of
 * the parameters of a call go g_dbus_proxy_call_....  Returns NULL
 * if it is unable to do the conversion.
 */
static GVariant *
scheme_object_to_parameter (Scheme_Object *obj, gchar *type)
{
  gchar *str;           // A temporary string

  // Special case: Array of bytes
  if (g_strcmp0 (type, "ay") == 0) 
    {
      if (SCHEME_BYTE_STRINGP (obj))
        {
          return g_variant_new_fixed_array (G_VARIANT_TYPE_BYTE,
                                            SCHEME_BYTE_STR_VAL (obj),
                                            SCHEME_BYTE_STRLEN_VAL (obj),
                                            sizeof (guchar));
        } // if it's a byte string
    } // array of bytes

  // Handle normal cases
  switch (type[0])
    {
      // Arrays
      case 'a':
        return scheme_object_to_array (obj, type);

      // Doubles
      case 'd':
        if (SCHEME_DBLP (obj))
          return g_variant_new ("d", SCHEME_DBL_VAL (obj));
        else if (SCHEME_FLTP (obj))
          return g_variant_new ("d", (double) SCHEME_FLT_VAL (obj));
        else if (SCHEME_INTP (obj))
          return g_variant_new ("d", (double) SCHEME_INT_VAL (obj));
        else if (SCHEME_RATIONALP (obj))
          return g_variant_new ("d", (double) scheme_rational_to_double (obj));
        else
          return NULL;

      // 32 bit integers
      case 'i':
        if (SCHEME_INTP (obj))
          return g_variant_new ("i", (int) SCHEME_INT_VAL (obj));
        else if (SCHEME_DBLP (obj))
          return g_variant_new ("i", (int) SCHEME_DBL_VAL (obj));
        else if (SCHEME_FLTP (obj))
          return g_variant_new ("i", (int) SCHEME_FLT_VAL (obj));
        else if (SCHEME_RATIONALP (obj))
          return g_variant_new ("i", (int) scheme_rational_to_double (obj));
        else 
          return NULL;

      // Strings
      case 's':
        str = scheme_object_to_string (obj);
        if (str == NULL)
          return NULL;
        return g_variant_new ("s", str);

      // 32 bit unsigned integers
      case 'u':
        if (SCHEME_INTP (obj))
          return g_variant_new ("u", (unsigned int) SCHEME_INT_VAL (obj));
        else
          return NULL;

      // Everything else is currently unsupported
      default:
        return NULL;
    } // switch
} // scheme_object_to_parameter
Beispiel #6
0
/**
 * Create a new proxy.
 */
static Scheme_Object *
loudbus_proxy (int argc, Scheme_Object **argv)
{
  gchar *service = NULL;        // A string giving the service
  gchar *path = NULL;           // A string giving the path to the object
  gchar *interface = NULL;      // A string giving the interface
  LouDBusProxy *proxy = NULL;   // The proxy we build
  Scheme_Object *result = NULL; // The proxy wrapped as a Scheme object
  GError *error = NULL;         // A place to hold errors

  service = scheme_object_to_string (argv[0]);

  // Annotations for garbage collection
  MZ_GC_DECL_REG (5);
  MZ_GC_VAR_IN_REG (0, argv);
  MZ_GC_VAR_IN_REG (1, service);
  MZ_GC_VAR_IN_REG (2, path);
  MZ_GC_VAR_IN_REG (3, interface);
  MZ_GC_VAR_IN_REG (4, result);
  MZ_GC_REG ();

  // Extract parameters
  service = scheme_object_to_string (argv[0]);
  path = scheme_object_to_string (argv[1]);
  interface = scheme_object_to_string (argv[2]);

  // Check parameters
  if (service == NULL)
    {
      MZ_GC_UNREG ();
      scheme_wrong_type ("loudbus-proxy", "string", 0, argc, argv);
    }
  if (path == NULL)
    {
      MZ_GC_UNREG ();
      scheme_wrong_type ("loudbus-proxy", "string", 1, argc, argv);
    }
  if (interface == NULL)
    {
      MZ_GC_UNREG ();
      scheme_wrong_type ("loudbus-proxy", "string", 2, argc, argv);
    }

  // Do the actual work in building the proxy.
  proxy = loudbus_proxy_new (service, path, interface, &error);
  if (proxy == NULL)
    {
      if (error == NULL)
        {
          MZ_GC_UNREG ();
          scheme_signal_error ("loudbus-proxy: "
                               "Could not create proxy for an unknown reason.");
        }
      else
        {
          MZ_GC_UNREG ();
          scheme_signal_error ("loudbus-proxy: "
                               "Could not create proxy because %s", 
                               error->message);
        }
    } // if (proxy == NULL)
  
  // Wrap the proxy into a Scheme type
  result = scheme_make_cptr (proxy, LOUDBUS_PROXY_TAG);

  // Log info during development
  LOG ("loudbus_proxy: Built proxy %p, Scheme object %p", proxy, result);

  // Find out information on what we just built.
  SCHEME_LOG ("result is", result);
  SCHEME_LOG ("result type is", SCHEME_CPTR_TYPE (result));
  
  // Register the finalizer
  scheme_register_finalizer (result, loudbus_proxy_finalize, NULL, NULL, NULL);

  // And we're done
  MZ_GC_UNREG ();
  return result;
} // loudbus_proxy
Beispiel #7
0
/**
 * Get information on one method (annotations, parameters, return
 * values, etc).
 *
 * TODO:
 *   1. Add missing documentation (see ????)
 *   2. Check to make sure that the second parameter is a string.  (Also
 *      do other error checking.  See below.)
 *   3. Make sure that you get annotations for parameters and return
 *      values (if they exist).
 *   4. Add tags for the other parts of the record (if they aren't
 *      there already).  For example, something like
 *      '((name gimp_image_new)
 *        (annotations "...")
 *        (inputs (width integer "width of image"))
 *        (outputs (image integer "id of created image")))
 *      If you'd prefer, input and output could also have their own
 *      tags.
 *        (inputs ((name width) (type integer) (annotations "width of image")))
 *   5. Add a function to louDBus/unsafe that pretty prints this.  
 *      (If you'd prefer, you can add it to this file.  But you can't
 *      use printf to pretty print.)
 *   6. Add information for the garbage collector.  (Yup, you'll need to
 *      read really bad documentation on this.  But try.)
 */
static Scheme_Object *
loudbus_method_info (int argc, Scheme_Object **argv)
{
  Scheme_Object *val, *val2;            // ????
  Scheme_Object *result = NULL;         // The result we're building
  Scheme_Object *arglist = NULL;        // The list of arguments
  Scheme_Object *outarglist = NULL;     // The list of return values
  Scheme_Object *annolist = NULL;       // The list of annotations   
  Scheme_Object *name = NULL;           // The method's name
  Scheme_Object *parampair = NULL;      // ????
  Scheme_Object *outparampair = NULL;   // ????
  GDBusMethodInfo *method;              // Information on one method
  GDBusAnnotationInfo *anno;            // Information on the annotations
  GDBusArgInfo *args, *outargs;         // Information on the arguments
  LouDBusProxy *proxy;                  // The proxy
  gchar *methodName;                    // The method name
  int m;                                // Counter variable for methods

  // Get the proxy
  proxy = scheme_object_to_proxy (argv[0]);
  if (proxy == NULL)
    {
      scheme_wrong_type ("loudbus-methods", "LouDBusProxy *", 0, argc, argv);
    } // if proxy == NULL

  //Get the method name.  WHAT IF WE CAN'T CONVERT TO A STRING????
  methodName = scheme_object_to_string (argv[1]);

  // Permit the use of dashes in method names by converting them back
  // to underscores (which is what we use over DBus).
  score_it_all (methodName);

  //Get the method struct.  WHAT IF THE METHOD DOESN'T EXIST????
  method = g_dbus_interface_info_lookup_method (proxy->iinfo, methodName);

  // Build the list for arguments.
  arglist = scheme_null;
  for (m = parray_len ((gpointer *) method->in_args) - 1; m >= 0; m--)
    {
      args = method->in_args[m]; //Go through the arguments.
      val = scheme_make_symbol (args->name);
      val2 = scheme_make_symbol (args->signature);
      parampair = scheme_make_pair (val, val2);
      arglist = scheme_make_pair (parampair, arglist);
    } // for each argument
 
  //Build list for output.
  outarglist = scheme_null;
  for (m = parray_len ((gpointer *) method->out_args) - 1; m >= 0; m--)
    {
      outargs = method->out_args[m];
      val = scheme_make_symbol (outargs->name);
      val2 = scheme_make_symbol (outargs->signature);
      outparampair = scheme_make_pair (val, val2);
      outarglist =  scheme_make_pair (outparampair, outarglist);
    } // for each output formals

  // Build list of annotations
  annolist = scheme_null;
  for (m = parray_len ((gpointer *) method->annotations) - 1; m >= 0; m--)
    {
      anno = method->annotations[m]; //Go through the annotations.
      val = scheme_make_locale_string (anno->value);
      annolist = scheme_make_pair (val, annolist);
    } // for each annotation

  // Create the name entry
  name = scheme_null;
  name = scheme_make_pair (scheme_make_symbol(methodName), name);
  name = scheme_make_pair (scheme_make_symbol("name"), name);

  result = scheme_null;
  result = scheme_make_pair (annolist, result);
  result = scheme_make_pair (outarglist, result);
  result = scheme_make_pair (arglist, result);
  result = scheme_make_pair (name, result);

  // And we're done.
  return result;
} // loudbus_method_info
Beispiel #8
0
/**
 * Import all of the methods from a LouDBusProxy.
 */
Scheme_Object *
loudbus_import (int argc, Scheme_Object **argv)
{
  Scheme_Env *env = NULL;       // The environment
  GDBusMethodInfo *method;      // Information on one method
  LouDBusProxy *proxy;            // The proxy
  int m;                        // Counter variable for methods
  int n;                        // The total number of methods
  int arity;                    // The arity of a method
  gchar *prefix = NULL;         // The prefix we use
  gchar *external_name;         // The name we use in Scheme
  int dashes;                   // Convert underscores to dashes?

  // Annotations and other stuff for garbage collection.
  MZ_GC_DECL_REG (3);
  MZ_GC_VAR_IN_REG (0, argv);
  MZ_GC_VAR_IN_REG (1, env);
  MZ_GC_VAR_IN_REG (2, prefix);
  MZ_GC_REG ();

  // Get the proxy
  proxy = scheme_object_to_proxy (argv[0]);
  if (proxy == NULL)
    {
      MZ_GC_UNREG ();
      scheme_wrong_type ("loudbus-import", "LouDBusProxy *", 0, argc, argv);
    } // if (proxy == NULL)

  // Get the prefix
  prefix = scheme_object_to_string (argv[1]);
  if (prefix == NULL)
    {
      MZ_GC_UNREG ();
      scheme_wrong_type ("loudbus-import", "string", 1, argc, argv);
    } // if (prefix == NULL)

  // Get the flag
  if (! SCHEME_BOOLP (argv[2]))
    {
      MZ_GC_UNREG ();
      scheme_wrong_type ("loudbus-import", "Boolean", 2, argc, argv);
    } // if (!SCHEME_BOOLB (argv[2])
  dashes = SCHEME_TRUEP (argv[2]);

  // Get the current environment, since we're mutating it.
  env = scheme_get_env (scheme_current_config ());

  // Process the methods
  n = g_dbus_interface_info_num_methods (proxy->iinfo);
  for (m = 0; m < n; m++)
    {
      method = proxy->iinfo->methods[m];
      arity = g_dbus_method_info_num_formals (method);
      external_name = g_strdup_printf ("%s%s", prefix, method->name);
      if (external_name != NULL)
        {
          if (dashes)
            {
              dash_it_all (external_name);
            } // if (dashes)

          // And add the procedure
          LOG ("loudbus-import: adding %s as %s", method->name, external_name);
          loudbus_add_dbus_proc (env, argv[0], 
                                 method->name, external_name, 
                                 arity);
          // Clean up
          g_free (external_name);
        } // if (external_name != NULL)
    } // for each method

  // And we're done.
  MZ_GC_UNREG ();
  return scheme_void;
} // loudbus_import