SCM scgi_session_alter_var (const SCM name, const SCM new_value)
{
/* todo: remove gh_scm2newstr when Guile 1.8 is released */
char *n;
char *v = gh_scm2newstr (new_value, NULL);
int retval;
if (SCM_SYMBOLP(name))
{
n = gh_symbol2newstr (name, NULL);
}
else
{
n = gh_scm2newstr (name, NULL);
}
retval = cgi_session_alter_var (n, v);
free (n);
free (v);
if (retval)
{
return SCM_BOOL_T;
}
else
{
return SCM_BOOL_F;
}
}
boolean cur_fieldp(SCM obj)
{
if (SCM_NIMP(obj) && SCM_SYMBOLP(obj)) {
char *s = ctl_symbol2newstr(obj);
int ret = !strcmp(s, "cur-field");
free(s);
return ret;
}
return 0;
}
/* Auxiliary function */
const char* Scm_GetCESName(ScmObj code, const char *argname)
{
const char *c = NULL;
if (SCM_UNBOUNDP(code) || SCM_FALSEP(code)) {
c = Scm_SupportedCharacterEncodings()[0];
} else if (SCM_STRINGP(code)) {
c = Scm_GetStringConst(SCM_STRING(code));
} else if (SCM_SYMBOLP(code)) {
c = Scm_GetStringConst(SCM_SYMBOL_NAME(code));
} else {
Scm_Error("string, symbol or #f is required for %s, but got %S",
argname, code);
}
return c;
}
static SPDPriority assign_priority(SCM priority, const char *func_name)
{
char *c_priority;
SCM_ASSERT(SCM_SYMBOLP(priority), priority, SCM_ARG3, func_name);
c_priority = SCM_SYMBOL_CHARS(priority);
{
const int invalid_priority = -1000;
int int_priority =
((!strcmp(c_priority, "important")) ? SPD_IMPORTANT
: (!strcmp(c_priority, "message")) ? SPD_MESSAGE
: (!strcmp(c_priority, "text")) ? SPD_TEXT
: (!strcmp(c_priority, "notification")) ? SPD_NOTIFICATION
: (!strcmp(c_priority, "progress")) ? SPD_PROGRESS
: invalid_priority);
if (int_priority == invalid_priority)
scm_wrong_type_arg(func_name, SCM_ARG3, priority);
return int_priority;
}
}
static long
enum2long (SCM obj, SCM enumstash, int pos, const char *FUNC_NAME)
{
long result = 0;
enum_struct *e = UNPACK_ENUM (enumstash);
if (SCM_SYMBOLP (obj))
{
obj = lookup (obj, e);
if (NOT_FALSEP (obj))
result = e->backing[C_INT (obj)].value;
}
else
{
ASSERT_INTEGER (obj, pos);
result = C_LONG (obj);
}
return result;
}
SCM scgi_session_save_path (SCM path)
{
/* todo: remove gh_scm2newstr when Guile 1.8 is released */
char *p;
if (SCM_SYMBOLP(path))
{
p = gh_symbol2newstr (path, NULL);
}
else
{
p = gh_scm2newstr (path, NULL);
}
cgi_session_save_path (p);
free (p);
return SCM_UNSPECIFIED;
}
SCM scgi_session_cookie_name (SCM name)
{
/* todo: remove gh_scm2newstr when Guile 1.8 is released */
char *n;
if (SCM_SYMBOLP(name))
{
n = gh_symbol2newstr (name, NULL);
}
else
{
n = gh_scm2newstr (name, NULL);
}
cgi_session_cookie_name (n);
free (n);
return SCM_UNSPECIFIED;
}
SCM scgi_session_var (SCM name)
{
/* todo: remove gh_scm2newstr when Guile 1.8 is released */
char *n;
char *retval;
if (SCM_SYMBOLP(name))
{
n = gh_symbol2newstr (name, NULL);
}
else
{
n = gh_scm2newstr (name, NULL);
}
retval = cgi_session_var (n);
free (n);
return scm_makfrom0str (retval);
}
int scm_is_symbol(SCM x) {
return SCM_SYMBOLP (x);
}
