Make environment variable procedures match R7RS
This commit is contained in:
parent
0ad800ea06
commit
40ba694ea6
41
c/builtins.c
41
c/builtins.c
|
@ -17,6 +17,8 @@
|
||||||
|
|
||||||
#include "scheme.h"
|
#include "scheme.h"
|
||||||
|
|
||||||
|
extern char **environ;
|
||||||
|
|
||||||
size_t llength(value_t v)
|
size_t llength(value_t v)
|
||||||
{
|
{
|
||||||
size_t n = 0;
|
size_t n = 0;
|
||||||
|
@ -357,13 +359,35 @@ static value_t fl_path_exists(value_t *args, uint32_t nargs)
|
||||||
return os_path_exists(str) ? FL_T : FL_F;
|
return os_path_exists(str) ? FL_T : FL_F;
|
||||||
}
|
}
|
||||||
|
|
||||||
static value_t fl_os_getenv(value_t *args, uint32_t nargs)
|
value_t builtin_get_environment_variables(value_t *args, uint32_t nargs)
|
||||||
|
{
|
||||||
|
struct accum acc = ACCUM_EMPTY;
|
||||||
|
char **pairs;
|
||||||
|
const char *pair;
|
||||||
|
const char *pivot;
|
||||||
|
value_t name, value;
|
||||||
|
|
||||||
|
(void)args;
|
||||||
|
argcount("get-environment-variables", nargs, 0);
|
||||||
|
for (pairs = environ; (pair = *pairs); pairs++) {
|
||||||
|
pivot = strchr(pair, '=');
|
||||||
|
if (!pivot) {
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
name = string_from_cstrn(pair, pivot - pair);
|
||||||
|
value = string_from_cstr(pivot + 1);
|
||||||
|
accum_pair(&acc, name, value);
|
||||||
|
}
|
||||||
|
return acc.list;
|
||||||
|
}
|
||||||
|
|
||||||
|
value_t builtin_get_environment_variable(value_t *args, uint32_t nargs)
|
||||||
{
|
{
|
||||||
char *name;
|
char *name;
|
||||||
char *val;
|
char *val;
|
||||||
|
|
||||||
argcount("os.getenv", nargs, 1);
|
argcount("get-environment-variable", nargs, 1);
|
||||||
name = tostring(args[0], "os.getenv");
|
name = tostring(args[0], "get-environment-variable");
|
||||||
val = getenv(name);
|
val = getenv(name);
|
||||||
if (val == NULL)
|
if (val == NULL)
|
||||||
return FL_F;
|
return FL_F;
|
||||||
|
@ -372,17 +396,17 @@ static value_t fl_os_getenv(value_t *args, uint32_t nargs)
|
||||||
return cvalue_static_cstring(val);
|
return cvalue_static_cstring(val);
|
||||||
}
|
}
|
||||||
|
|
||||||
static value_t fl_os_setenv(value_t *args, uint32_t nargs)
|
value_t builtin_set_environment_variable(value_t *args, uint32_t nargs)
|
||||||
{
|
{
|
||||||
const char *name;
|
const char *name;
|
||||||
const char *value;
|
const char *value;
|
||||||
|
|
||||||
argcount("os.setenv", nargs, 2);
|
argcount("set-environment-variable", nargs, 2);
|
||||||
name = tostring(args[0], "os.setenv");
|
name = tostring(args[0], "set-environment-variable");
|
||||||
if (args[1] == FL_F) {
|
if (args[1] == FL_F) {
|
||||||
value = 0;
|
value = 0;
|
||||||
} else {
|
} else {
|
||||||
value = tostring(args[1], "os.setenv");
|
value = tostring(args[1], "set-environment-variable");
|
||||||
}
|
}
|
||||||
os_setenv(name, value);
|
os_setenv(name, value);
|
||||||
return FL_T;
|
return FL_T;
|
||||||
|
@ -511,8 +535,7 @@ static struct builtinspec builtin_info[] = {
|
||||||
{ "path.cwd", fl_path_cwd },
|
{ "path.cwd", fl_path_cwd },
|
||||||
{ "path.exists?", fl_path_exists },
|
{ "path.exists?", fl_path_exists },
|
||||||
|
|
||||||
{ "os.getenv", fl_os_getenv },
|
{ "os.getenv", builtin_get_environment_variable }, // TODO: remove
|
||||||
{ "os.setenv", fl_os_setenv },
|
|
||||||
|
|
||||||
{ "import-procedure", builtin_import },
|
{ "import-procedure", builtin_import },
|
||||||
|
|
||||||
|
|
|
@ -84,6 +84,13 @@ static struct builtin_procedure builtin_procedures[] = {
|
||||||
{ "read-directory", builtin_os_read_directory, SRFI_170 | UP_2019 },
|
{ "read-directory", builtin_os_read_directory, SRFI_170 | UP_2019 },
|
||||||
{ "close-directory", builtin_os_close_directory, SRFI_170 | UP_2019 },
|
{ "close-directory", builtin_os_close_directory, SRFI_170 | UP_2019 },
|
||||||
|
|
||||||
|
{ "get-environment-variables", builtin_get_environment_variables,
|
||||||
|
R7RS_PROCESS_CONTEXT | UP_2019 },
|
||||||
|
{ "get-environment-variable", builtin_get_environment_variable,
|
||||||
|
R7RS_PROCESS_CONTEXT | UP_2019 },
|
||||||
|
{ "set-environment-variable", builtin_set_environment_variable,
|
||||||
|
R7RS_PROCESS_CONTEXT | UP_2019 },
|
||||||
|
|
||||||
{ 0, 0, 0 },
|
{ 0, 0, 0 },
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
|
@ -996,6 +996,10 @@ value_t builtin_read_ini_file(value_t *args, uint32_t nargs);
|
||||||
|
|
||||||
value_t builtin_color_name_to_rgb24(value_t *args, uint32_t nargs);
|
value_t builtin_color_name_to_rgb24(value_t *args, uint32_t nargs);
|
||||||
|
|
||||||
|
value_t builtin_get_environment_variables(value_t *args, uint32_t nargs);
|
||||||
|
value_t builtin_get_environment_variable(value_t *args, uint32_t nargs);
|
||||||
|
value_t builtin_set_environment_variable(value_t *args, uint32_t nargs);
|
||||||
|
|
||||||
//// #include "stringfuncs.h"
|
//// #include "stringfuncs.h"
|
||||||
|
|
||||||
value_t fl_stringp(value_t *args, uint32_t nargs);
|
value_t fl_stringp(value_t *args, uint32_t nargs);
|
||||||
|
|
Loading…
Reference in New Issue