/** * 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
/** * 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
/** * 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
/** * 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
/** * 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
/** * 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
/** * 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
/** * 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