src/scm.c

   1 #include <bash/config.h>
   2 #include <stdlib.h>
   3 #include <bash/builtins.h>
   4 #include <bash/shell.h>
   5 #include <stdio.h>
   6 #include <libguile.h>
   7
   8 static SCM magic_variables_alist = SCM_EOL;
   9
  10 static SCM
  11 magic_dynamic_value_body(void *data)
  12 {
  13         struct variable* self = data;
  14         const char *varname = self->name;
  15         SCM symbol = scm_string_to_symbol(scm_from_utf8_string(varname));
  16         SCM thunk = scm_assq_ref(magic_variables_alist, symbol);
  17         SCM value = scm_call_0(thunk);
  18         char *newvalue = scm_to_utf8_stringn(value, NULL);
  19
  20         free(self->value);
  21         self->value = newvalue;
  22         return SCM_UNDEFINED;
  23 }
  24
  25 static SCM
  26 magic_dynamic_value_exception_handler(void *_unused, SCM key, SCM args)
  27 {
  28         return scm_print_exception
  29                 (scm_current_error_port(), SCM_BOOL_F, key, args);
  30 }
  31
  32 static struct variable*
  33 magic_dynamic_value(struct variable *self)
  34 {
  35         scm_internal_catch(SCM_BOOL_T, &magic_dynamic_value_body, self,
  36                            &magic_dynamic_value_exception_handler, NULL);
  37         return self;
  38 }
  39
  40 static SCM
  41 scm_bind_magic_variable(SCM symbol, SCM thunk)
  42 {
  43         char *varname;
  44         struct variable *v;
  45
  46         SCM_ASSERT_TYPE(scm_is_symbol(symbol), symbol,
  47                         SCM_ARG1, __func__, "symbol");
  48         SCM_ASSERT_TYPE(scm_is_true(scm_thunk_p(thunk)), thunk,
  49                         SCM_ARG2, __func__, "thunk");
  50
  51         varname = scm_to_utf8_stringn(scm_symbol_to_string(symbol), NULL);
  52         v = bind_variable(varname, NULL, 0);
  53         v->dynamic_value = &magic_dynamic_value;
  54         magic_variables_alist = scm_assq_set_x(magic_variables_alist, symbol, thunk);
  55         free(varname);
  56         return SCM_UNDEFINED;
  57 }
  58
  59
  60
  61 extern char **make_builtin_argv (WORD_LIST *, int *);
  62
  63 struct guile_builtin_state {
  64         int argc;    /* Formed by `make_builtin_argv' in `guile_builtin' */
  65         char *filename;
  66         char **argv;
  67         int retval; /* Passed back from do_guile_builtin */
  68 };
  69
  70 static SCM
  71 guile_builtin_body (void *data)
  72 {
  73         const struct guile_builtin_state *state = data;
  74         return scm_c_primitive_load_path(state->filename);
  75 }
  76 static SCM
  77 guile_builtin_exception_handler (void *data, SCM key, SCM args)
  78 {
  79         struct guile_builtin_state *state = data;
  80         state->retval = EXECUTION_FAILURE;
  81         return scm_print_exception
  82           (scm_current_error_port(), SCM_BOOL_F, key, args);
  83 }
  84
  85 static void*
  86 do_guile_builtin (void *data)
  87 {
  88         struct guile_builtin_state *state = data;
  89         scm_c_define_gsubr("bash:bind-magic-variable", 2, 0, 0,
  90                            &scm_bind_magic_variable);
  91
  92         /* For Guile, argv[0] will be filename to be loaded. Not too useful, */
  93         /* but it is all about minimizing C codebase  */
  94         scm_set_program_arguments(state->argc, state->argv, state->filename);
  95         scm_internal_catch(SCM_BOOL_T, &guile_builtin_body, state,
  96                            &guile_builtin_exception_handler, state);
  97         return NULL;
  98 }
  99
 100 static int
 101 guile_builtin (WORD_LIST *list)
 102 {
 103         struct guile_builtin_state state;
 104         int argc;
 105         char **argv;
 106
 107         argv = make_builtin_argv(list, &argc);
 108         if (argc < 2) {
 109                 builtin_error("not enough arguments.");
 110                 builtin_usage();
 111                 return EXECUTION_FAILURE;
 112         }
 113         state.filename = argv[1];
 114         state.argc = argc - 2;
 115         state.argv = argv + 2;
 116         state.retval = EXECUTION_SUCCESS;
 117         scm_with_guile(do_guile_builtin, &state);
 118
 119         return state.retval;
 120 }
 121
 122 static char* const guile_doc[] = {
 123         "",
 124         "Load Guile code from file with access to (gnu bash) module",
 125         "to control Bash internals. Feel free to crash it all. ",
 126         "",
 127         "Return code 0, unless exception is thrown",
 128         NULL
 129 };
 130
 131 struct builtin scm_struct = {
 132         .name = "scm",
 133         .function = guile_builtin,
 134         .flags = BUILTIN_ENABLED,
 135         .long_doc = guile_doc,
 136         .short_doc = "scm FILENAME [ARGS ...]",
 137         .handle = NULL
 138 };