static void rline_call_update_hook (SLrline_Type *rli,
SLFUTURE_CONST char *prompt,
SLFUTURE_CONST char *buf,
unsigned int len,
unsigned int point, VOID_STAR cd)
{
Rline_CB_Type *cb;
(void) rli;
(void) len;
cb = (Rline_CB_Type *)cd;
if (-1 == SLang_start_arg_list ())
return;
if ((-1 == SLang_push_mmt (cb->mmt))
|| (-1 == SLang_push_string (prompt))
|| (-1 == SLang_push_string (buf))
|| (-1 == SLang_push_int ((int) point))
|| ((cb->cd != NULL) && (-1 == SLang_push_anytype (cb->cd))))
{
(void) SLang_end_arg_list ();
return;
}
(void) SLexecute_function (cb->update_hook);
}
static void get_passwd_cmd (char *name) /*{{{*/
{
char *password = NULL;
char *dir = NULL;
char *shell = NULL;
int uid = -1, gid = -1;
#if HAS_PASSWORD_CODE
struct passwd *pwent;
if (*name == 0)
pwent = getpwuid (getuid ());
else
pwent = getpwnam (name);
if (pwent != NULL)
{
password = pwent->pw_passwd;
uid = pwent->pw_uid;
gid = pwent->pw_gid;
dir = pwent->pw_dir;
shell = pwent->pw_shell;
}
#endif
if (password == NULL) password = "";
if (dir == NULL) dir = "";
if (shell == NULL) shell = "";
(void) SLang_push_string (dir);
(void) SLang_push_string (shell);
(void) SLang_push_string (password);
(void) SLang_push_integer (uid);
(void) SLang_push_integer (gid);
}
int _pSLcall_bof_handler (SLFUTURE_CONST char *fun, SLFUTURE_CONST char *file)
{
int status = 0, err;
if (BOF_Callback_Handler == NULL)
return 0;
if (Handler_Active)
return 0;
if ((0 != (err = _pSLang_Error))
&& (-1 == _pSLang_push_error_context ()))
return -1;
Handler_Active++;
if ((-1 == SLang_start_arg_list ())
|| (-1 == SLang_push_string (fun))
|| (-1 == SLang_push_string (file))
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (BOF_Callback_Handler)))
{
set_bof_eof_handlers (NULL, NULL);
status = -1;
}
Handler_Active--;
if (err)
_pSLang_pop_error_context (status != 0);
return status;
}
int _Plot_label_box (char *xlabel, char *ylabel, char *tlabel) /*{{{*/
{
int status;
if (pli_undefined())
return -1;
if (PLI->label_axes == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: label_axes operation is not supported");
return -1;
}
SLang_start_arg_list ();
SLang_push_string (xlabel);
SLang_push_string (ylabel);
SLang_push_string (tlabel);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->label_axes))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "plot: label_axes failed");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "plot: label_axes failed");
return -1;
}
return status;
}
static void sl_base64_encode (void){
SLang_BString_Type* input;
unsigned char* inbuf;
BIO *bio, *b64;
BUF_MEM *bptr;
char *buff;
int i,inlen;
if (SLang_Num_Function_Args != 1 ||
SLang_pop_bstring(&input) == -1 ){
return; }
inbuf = SLbstring_get_pointer(input, &inlen);
b64 = BIO_new(BIO_f_base64());
bio = BIO_new(BIO_s_mem());
b64 = BIO_push(b64,bio);
BIO_write(b64,inbuf,inlen);
BIO_flush(b64);
BIO_get_mem_ptr(b64, &bptr);
buff = (char*)malloc(bptr->length);
memcpy(buff, bptr->data, bptr->length-1);
buff[bptr->length-1] = 0;
BIO_free_all(b64);
SLang_push_string((char*)buff);
SLbstring_free(input);
free(buff);
}
/* int _pSLcall_debug_hook (char *file, int line, char *funct) */
int _pSLcall_debug_hook (SLFUTURE_CONST char *file, int line)
{
int status = 0, err;
if (Debug_Hook == NULL)
return 0;
if (Debug_Handler_Active)
return 0;
if ((0 != (err = _pSLang_Error))
&& (-1 == _pSLang_push_error_context ()))
return -1;
Debug_Handler_Active++;
if ((-1 == SLang_start_arg_list ())
|| (-1 == SLang_push_string (file))
|| (-1 == SLclass_push_int_obj (SLANG_INT_TYPE, line))
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (Debug_Hook)))
{
status = -1;
set_debug_hook (NULL);
}
Debug_Handler_Active--;
if (err)
(void) _pSLang_pop_error_context (status != 0);
return status;
}
int _pSLcall_bos_handler (SLFUTURE_CONST char *file, int line)
{
int status = 0;
int err;
if (BOS_Callback_Handler == NULL)
return 0;
if (Handler_Active)
return 0;
if ((0 != (err = _pSLang_Error))
&& (-1 == _pSLang_push_error_context ()))
return -1;
Handler_Active++;
if ((-1 == SLang_start_arg_list ())
|| (-1 == SLang_push_string (file))
|| (-1 == SLclass_push_int_obj (SLANG_INT_TYPE, line))
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (BOS_Callback_Handler)))
{
set_bos_eos_handlers (NULL, NULL);
status = -1;
}
Handler_Active--;
if (err)
_pSLang_pop_error_context (status != 0);
return status;
}
/* convert integer to a string of length 1 */
static void char_cmd (SLwchar_Type *x) /*{{{*/
{
SLuchar_Type buf[SLUTF8_MAX_MBLEN + 1];
int is_byte;
is_byte = ((signed)*x < 0);
if (is_byte)
{
buf[0] = (SLuchar_Type) (-(signed)*x);
buf[1] = 0;
}
else if ((_pSLinterp_UTF8_Mode == 0)
|| (*x < 0x80))
{
buf[0] = (SLuchar_Type) *x;
buf[1] = 0;
}
else
{
SLuchar_Type *p;
p = SLutf8_encode (*x, buf, SLUTF8_MAX_MBLEN);
if (p == NULL) p = buf;
*p = 0;
}
SLang_push_string ((char *)buf);
}
int SLang_run_hooks (SLFUTURE_CONST char *hook, unsigned int num_args, ...)
{
unsigned int i;
va_list ap;
if (SLang_get_error ())
return -1;
if (0 == SLang_is_defined (hook))
return 0;
(void) SLang_start_arg_list ();
va_start (ap, num_args);
for (i = 0; i < num_args; i++)
{
char *arg;
arg = va_arg (ap, char *);
if (-1 == SLang_push_string (arg))
break;
}
va_end (ap);
(void) SLang_end_arg_list ();
if (_pSLang_Error) return -1;
return SLang_execute_function (hook);
}
int Plot_open (char *device) /*{{{*/
{
int id;
if (pli_undefined())
return -1;
if (PLI->open == NULL)
return -1;
SLang_start_arg_list ();
SLang_push_string (device);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->open))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed opening plot device");
return -1;
}
if ((-1 == SLang_pop_integer (&id))
|| (id <= 0))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed opening plot device");
return -1;
}
return id;
}
char *Plot_configure_axis (char *opt, int is_log, int has_numbers) /*{{{*/
{
char *s;
if (pli_undefined())
return NULL;
if (PLI->configure_axis == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: configure_axis operation is not supported");
return NULL;
}
SLang_start_arg_list ();
SLang_push_string (opt);
SLang_push_integer (is_log);
SLang_push_integer (has_numbers);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->configure_axis))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "plot: configure_axis failed");
return NULL;
}
if (-1 == SLpop_string (&s))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "plot: configure_axis failed");
return NULL;
}
return s;
}
static void slang_to_pcre (char *pattern)
{
/* NULL ok in code below */
pattern = _slang_to_pcre (pattern);
(void) SLang_push_string (pattern);
SLang_free_slstring (pattern);
}
static void posix_ttyname (void)
{
SLFile_FD_Type *f;
SLang_MMT_Type *mmt;
int fd;
char buf[512];
int e;
if (SLang_Num_Function_Args == 0)
{
fd = 0;
f = NULL;
mmt = NULL;
}
else if (-1 == pop_fd (&fd, &f, &mmt))
return;
if (0 != (e = TTYNAME_R (fd, buf, sizeof(buf))))
{
_pSLerrno_errno = e;
SLang_push_null ();
}
else
(void) SLang_push_string (buf);
if (mmt != NULL) SLang_free_mmt (mmt);
if (f != NULL) SLfile_free_fd (f);
}
static void path_extname (char *path)
{
#ifdef VMS
char *p;
#endif
path = SLpath_extname (path);
#ifndef VMS
SLang_push_string (path);
#else
p = strchr (path, ';');
if (p == NULL)
(void)SLang_push_string (p);
else
(void)SLang_push_malloced_string (SLmake_nstring (path, (unsigned int)(p - path)));
#endif
}
static void check_intrin_string_qualifier (char *name, char *def)
{
char *s;
if (-1 == SLang_get_string_qualifier (name, &s, def))
return;
SLang_push_string (s);
SLang_free_slstring (s);
}
static void verb_warn_func (const char *msg)
{
if (Verb_Warn_Func != NULL)
{
if (0 == SLang_push_string ((char *) msg))
SLexecute_function (Verb_Warn_Func);
}
}
static void find_file_in_path (char *path, char *name) /*{{{*/
{
char *pathname;
pathname = SLpath_find_file_in_path (path, name);
(void) SLang_push_string (pathname);
SLfree(pathname);
}
void define_top_screen_line (char *neew)
{
SLang_push_string (Top_Screen_Line_Buffer);
strncpy (Top_Screen_Line_Buffer, neew, sizeof (Top_Screen_Line_Buffer) - 1);
Top_Screen_Line_Buffer[sizeof(Top_Screen_Line_Buffer) - 1] = 0;
if (JScreen != NULL)
JScreen[0].is_modified = 1;
}
static void strftime_cmd (void)
{
/* Rather then using some sort of portable version of strftime, which would
* miss the locale-specific features, just call the system routine. However,
* it cannot be called blindly because some versions (e.g., the the one from
* c.snippets.org) do no input checking, and use code such as
*
* static char *day[] = {"Sunday", "Monday", ..., "Saturday"};
* [...]
* switch (*f++)
* {
* case 'A' :
* r = day[t->tm_wday];
* break;
* [...]
*
* and lead to a SEGV if t->tm_wday is not in the range [0:6].
*/
struct tm tms;
char buf[4096];
int status;
char *fmt;
if (SLang_Num_Function_Args == 1)
{
time_t t = time(NULL);
if (-1 == call_localtime (t, &tms))
return;
if (-1 == validate_tm (&tms))
return;
}
else if (-1 == pop_tm_struct (&tms))
return;
if (-1 == SLang_pop_slstring (&fmt))
return;
/* Ugh. The man page says:
*
* The strftime() function returns the number of characters placed in the
* array s, not including the terminating NUL character, provided the
* string, including the terminating NUL, fits. Otherwise, it returns 0,
* and the contents of the array is undefined. (Thus at least since libc
* 4.4.4; very old versions of libc, such as libc 4.4.1, would return max
* if the array was too small.)
*
* Note that the return value 0 does not necessarily indicate an error;
* for example, in many locales %p yields an empty string.
*
* Was this too designed by committee?
*/
status = strftime (buf, sizeof(buf), fmt, &tms);
if (status == 0)
buf[0] = 0;
buf[sizeof(buf)-1] = 0;
(void) SLang_push_string (buf);
SLang_free_slstring (fmt);
}
void Fit_push_kernel_names (Isis_Kernel_Def_t *t) /*{{{*/
{
Isis_Kernel_Def_t *def = NULL;
for (def = t; def != NULL; def = def->next)
{
SLang_push_string (def->kernel_name);
}
}
/* This function _always_ frees the malloced string */
int SLang_push_malloced_string (char *c) /*{{{*/
{
int ret;
ret = SLang_push_string (c);
SLfree (c);
return ret;
}
static int get_str_sockopt (Socket_Type *s, int level, int optname)
{
char buf[1024];
socklen_t len = sizeof (buf)-1;
if (-1 == do_getsockopt (s->fd, level, optname, (void *)buf, &len))
return -1;
buf[len] = 0;
return SLang_push_string (buf);
}
static int execute_fun_with_args (SLang_Name_Type *nt, unsigned int argc,
char **argv)
{
unsigned int i;
(void) SLang_start_arg_list ();
for (i = 0; i < argc; i++)
(void) SLang_push_string (argv[i]);
(void) SLang_end_arg_list ();
return SLexecute_function (nt);
}
static void rline_get_line_intrinsic (void)
{
char *s;
if ((Active_Rline_Info == NULL)
|| (NULL == (s = SLrline_get_line (Active_Rline_Info))))
{
(void) SLang_push_string ("");
return;
}
(void) SLang_push_malloced_string (s);
}
int _Plot_draw_box (char *xopt, float xtick, int nxsub, /*{{{*/
char *yopt, float ytick, int nysub)
{
int status;
if (pli_undefined())
return -1;
if (PLI->draw_box == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: draw_box operation is not supported");
return -1;
}
SLang_start_arg_list ();
SLang_push_string (xopt);
SLang_push_float (xtick);
SLang_push_integer (nxsub);
SLang_push_string (yopt);
SLang_push_float (ytick);
SLang_push_integer (nysub);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->draw_box))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "plot: draw_box failed");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "plot: draw_box failed");
return -1;
}
return status;
}
int Plot_put_text_offset (char *where, float offset, float ox, float oy, char *text) /*{{{*/
{
int status;
if (pli_undefined())
return -1;
if (PLI->put_text_offset == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: put_text_offset operation is not supported");
return -1;
}
SLang_start_arg_list ();
SLang_push_string (where);
SLang_push_float (offset);
SLang_push_float (ox);
SLang_push_float (oy);
SLang_push_string (text);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->put_text_offset))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "plot: put_text_offset failed");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "plot: put_text_offset failed");
return -1;
}
return status;
}
static int cl_foreach (SLtype type, SLang_Foreach_Context_Type *c)
{
SLang_Assoc_Array_Type *a;
_pSLAssoc_Array_Element_Type *e, *emax;
(void) type;
if (c == NULL)
return -1;
a = c->a;
e = a->elements + c->next_hash_index;
emax = a->elements + a->table_len;
while (1)
{
if (e == emax)
return 0;
if ((e->key != NULL) && (e->key != Deleted_Key))
break;
e++;
}
c->next_hash_index = (e - a->elements) + 1;
if ((c->flags & CTX_WRITE_KEYS)
&& (-1 == SLang_push_string (e->key)))
return -1;
if (c->flags & CTX_WRITE_VALUES)
{
#if SLANG_OPTIMIZE_FOR_SPEED
if (c->is_scalar)
{
if (-1 == SLang_push (&e->value))
return -1;
}
else
#endif
if (-1 == _pSLpush_slang_obj (&e->value))
return -1;
}
/* keep going */
return 1;
}
static void _pgqinf (char *item)
{
char buf[1024];
int len;
len = (int) sizeof(buf);
cpgqinf (item, buf, &len);
if (len < 0)
len = 0;
if (len >= (int) sizeof (buf))
len = sizeof (buf) - 1;
buf[len] = 0;
(void) SLang_push_string (buf);
}
static int intrin_get_defines (void)
{
int n = 0;
SLFUTURE_CONST char **s = _pSLdefines;
while (*s != NULL)
{
if (-1 == SLang_push_string (*s))
{
SLdo_pop_n ((unsigned int) n);
return -1;
}
s++;
n++;
}
return n;
}
static void nth_substr (Onig_Type *o, char *str, int *np)
{
unsigned int start, stop;
unsigned int len;
len = strlen (str);
if ((-1 == get_nth_start_stop (o, (unsigned int) *np, &start, &stop))
|| (start > len) || (stop > len))
{
SLang_push_null ();
return;
}
str = SLang_create_nslstring (str + start, stop - start);
(void) SLang_push_string (str);
SLang_free_slstring (str);
}
