new API

and code cleanup

src/load-script.c

@@ -0,0 +1,104 @@
+#include <assert.h>
+#include <stdio.h>
+#include <libguile.h>
+
+/**
+ * ISO C forbids casting a function pointer to a void pointer because on some
+ * architectures they have different sizes. However scm_c_define_gsubr() wants
+ * a function pointer as a void pointer, which trips -Wpedantic. Compiling C
+ * without pedantic errors is not a reasonable option in my opinion, so instead
+ * we'll have to resort to this hack.
+ */
+#define scm_c_define_gsubr_fix(NAME, REQ, OPT, RST, FN) \
+	{ const long int ptr = (long int)FN; scm_c_define_gsubr(NAME, REQ, OPT, RST, (void *)ptr); }
+
+extern SCM layout_demand_handler;
+extern SCM user_command_handler;
+
+static SCM install_handler (SCM key, SCM proc)
+{
+	if ( scm_is_false(scm_symbol_p(key)) == 1 )
+	{
+		scm_error_scm(
+			scm_from_utf8_symbol("wrong-type-arg"),
+			scm_from_utf8_string("install-handler"),
+			scm_from_utf8_string("First argument must be a symbol."),
+			SCM_BOOL_F,
+			scm_list_1(key)
+		);
+		return SCM_UNSPECIFIED;
+	}
+
+	// TODO check if the procedure has the right amount of arguments.
+	if ( scm_is_false(scm_procedure_p(proc)) == 1 )
+	{
+		scm_error_scm(
+			scm_from_utf8_symbol("wrong-type-arg"),
+			scm_from_utf8_string("install-handler"),
+			scm_from_utf8_string("Second argument must be a procedure."),
+			SCM_BOOL_F,
+			scm_list_1(proc)
+		);
+		return SCM_UNSPECIFIED;
+	}
+
+	if (scm_is_eq(scm_from_utf8_symbol("layout-demand"), key))
+		layout_demand_handler = proc;
+	else if (scm_is_eq(scm_from_utf8_symbol("user-command"), key))
+		user_command_handler = proc;
+	else
+	{
+		scm_error_scm(
+			// TODO should this be 'misc-error instead?
+			scm_from_utf8_symbol("out-of-range"),
+			scm_from_utf8_string("install-handler"),
+			scm_from_utf8_string("Unknown key: ~A"),
+			scm_list_1(key),
+			scm_list_1(key)
+		);
+		return SCM_UNSPECIFIED;
+	}
+
+	return SCM_BOOL_T;
+}
+
+static void *load_script_inner (void *data)
+{
+	const char *path = (char *)data;
+
+	/* scm_primitive_load_path() searches guiles load-path when encountering
+	 * a relative path. That should never happen here though.
+	 */
+	assert(path[0] == '/');
+
+	return scm_primitive_load_path(scm_from_utf8_string(path));
+}
+
+void *load_script (void *data)
+{
+	/* Note: All guile objects are garbage collected. */
+
+	scm_c_define_gsubr_fix("install-handler", 2, 0, 0, install_handler);
+
+	/* Continuation barrier causes stack unwind on exceptions to stop here.
+	 * Otherwise the entire stack created by scm_with_guile() would be
+	 * unwound. This makes responding to exceptions nicer.
+	 */
+	SCM call_result = scm_c_with_continuation_barrier(
+		load_script_inner, data
+	);
+
+	if ( call_result == NULL )
+		return (void *)"ERROR: Fatal error while loading layout script.\n";
+
+	if ( layout_demand_handler == NULL )
+		return (void *)"ERROR: No layout demand handler installed.\n";
+
+	/* Checked in the installer functions. */
+	assert(scm_is_true(scm_procedure_p(layout_demand_handler)) == 1);
+	if ( user_command_handler != NULL )
+		assert(scm_is_true(scm_procedure_p(user_command_handler)) == 1);
+
+	return NULL;
+}
+