int SLcurses_delwin (SLcurses_Window_Type *w)
{
if (w == NULL) return 0;
if (w->lines != NULL)
{
SLcurses_Cell_Type **lines = w->lines;
if (w->is_subwin == 0)
{
unsigned int r, rmax;
rmax = w->nrows;
for (r = 0; r < rmax; r++)
{
SLfree ((char *)lines[r]);
}
}
SLfree ((char *)lines);
}
SLfree ((char *)w);
if (w == SLcurses_Stdscr)
SLcurses_Stdscr = NULL;
return 0;
}
static void posix_fdopen (SLFile_FD_Type *f, char *mode)
{
Stdio_MMT_List_Type *elem;
if (NULL == (elem = alloc_stdio_list_elem ()))
return;
if (-1 == _pSLstdio_fdopen (f->name, f->fd, mode))
{
SLfree ((char *)elem);
return;
}
if (NULL == (elem->stdio_mmt = SLang_pop_mmt (SLANG_FILE_PTR_TYPE)))
{
SLfree ((char *) elem);
return;
}
if (-1 == SLang_push_mmt (elem->stdio_mmt))
{
SLfree ((char *) elem);
return;
}
elem->next = f->stdio_mmt_list;
f->stdio_mmt_list = elem;
}
static void delete_assoc_array (SLang_Assoc_Array_Type *a)
{
_pSLAssoc_Array_Element_Type *e, *emax;
#if SLANG_OPTIMIZE_FOR_SPEED
int is_scalar_type = a->is_scalar_type;
#endif
if (a == NULL) return;
e = a->elements;
if (e != NULL)
{
emax = e + a->table_len;
while (e < emax)
{
if ((e->key != NULL) && (e->key != Deleted_Key))
{
_pSLfree_hashed_string ((char *)e->key, strlen (e->key), e->hash);
#if SLANG_OPTIMIZE_FOR_SPEED
if ((is_scalar_type == 0) && (e->value.o_data_type != SLANG_INT_TYPE))
#endif
SLang_free_object (&e->value);
}
e++;
}
SLfree ((char *) a->elements);
}
if (a->flags & HAS_DEFAULT_VALUE)
SLang_free_object (&a->default_value);
SLfree ((char *) a);
}
void SLrline_close (SLrline_Type *rli)
{
if (rli == NULL)
return;
if (rli->name != NULL)
{
char hookname[1024];
SLrline_Type *arli = Active_Rline_Info;
Active_Rline_Info = rli;
SLsnprintf (hookname, sizeof(hookname), "%s_rline_close_hook", rli->name);
if (0 == SLang_run_hooks (hookname, 0))
(void) SLang_run_hooks ("rline_close_hook", 1, rli->name);
Active_Rline_Info = arli;
SLang_free_slstring (rli->name);
}
free_history (rli->root);
free_history_item (rli->saved_line);
SLang_free_function (rli->list_completions_callback);
SLang_free_function (rli->completion_callback);
SLfree ((char *)rli->prompt);
SLfree ((char *)rli->buf);
SLfree ((char *)rli);
}
static int exec_what (int what, int has_envp)
{
SLang_Array_Type *at_argv = NULL;
SLang_Array_Type *at_envp = NULL;
char **argv = NULL, **envp = NULL;
char *path = NULL;
int status = -1;
if (has_envp)
{
if (NULL == (envp = pop_argv (&at_envp)))
goto free_and_return;
}
if (NULL == (argv = pop_argv (&at_argv)))
goto free_and_return;
if (-1 == SLang_pop_slstring (&path))
goto free_and_return;
status = call_what (what, path, argv, envp);
free_and_return:
if (path != NULL) SLang_free_slstring (path);
if (argv != NULL) SLfree ((char *)argv);
if (at_argv != NULL) SLang_free_array (at_argv);
if (envp != NULL) SLfree ((char *)envp);
if (at_envp != NULL) SLang_free_array (at_envp);
return status;
}
static int example_3 (void)
{
SLrline_Type *rl;
unsigned int width = 80;
if ((-1 == SLang_init_all ())
|| (-1 == SLang_init_array_extra ())
|| (-1 == SLang_init_import ()))
return -1;
(void) SLpath_set_load_path ("../slsh/lib");
if (-1 == SLrline_init ("demo/rline", NULL, NULL))
return -1;
issue_instructions ();
SLang_init_tty (-1, 0, 1);
SLang_set_abort_signal (NULL);
rl = SLrline_open2 ("rline", width, SL_RLINE_BLINK_MATCH);
if (rl == NULL)
return -1;
while (1)
{
char *line;
unsigned int len;
line = SLrline_read_line (rl, "prompt>", &len);
if (line == NULL)
{
int err = SLang_get_error ();
if (err == SL_UserBreak_Error)
{
(void) fprintf (stderr, "*Interrupted*\n");
SLang_set_error (0);
SLKeyBoard_Quit = 0;
continue;
}
if (err == 0)
break; /* EOF */
fprintf (stderr, "Error Occurred: %s\n", SLerr_strerror (err));
break;
}
if (0 == strcmp (line, "quit"))
{
SLfree (line);
break;
}
(void) fprintf (stdout, "\nRead %d bytes: %s\n", strlen(line), line);
if (-1 == SLrline_save_line (rl))
break;
SLfree (line);
}
SLrline_close (rl);
SLang_reset_tty ();
return 0;
}
static int example_1 (void)
{
SLrline_Type *rl;
unsigned int width = 80;
issue_instructions ();
SLang_init_tty (-1, 0, 1);
rl = SLrline_open (width, SL_RLINE_BLINK_MATCH);
while (1)
{
char *line;
unsigned int len;
line = SLrline_read_line (rl, "prompt>", &len);
if (line == NULL)
break;
if (0 == strcmp (line, "quit"))
{
SLfree (line);
break;
}
(void) fprintf (stdout, "\nRead %d bytes: %s\n", strlen(line), line);
SLfree (line);
}
SLrline_close (rl);
SLang_reset_tty ();
return 0;
}
void SLbstring_free (SLang_BString_Type *b)
{
if (b == NULL)
return;
if (b->num_refs > 1)
{
b->num_refs -= 1;
return;
}
switch (b->ptr_type)
{
case 0:
case IS_NOT_TO_BE_FREED:
default:
break;
case IS_SLSTRING:
SLang_free_slstring ((char *)b->v.ptr);
break;
case IS_MALLOCED:
SLfree ((char *)b->v.ptr);
break;
}
SLfree ((char *) b);
}
static void free_host_addr_info (Host_Addr_Info_Type *hinfo)
{
if (hinfo == NULL)
return;
if (hinfo->h_addr_list != NULL)
SLfree ((char *)hinfo->h_addr_list);
SLfree ((char *) hinfo);
}
void SLwchar_free_lut (SLwchar_Lut_Type *r)
{
if (r == NULL)
return;
SLfree ((char *) r->chmin);
SLfree ((char *) r->chmax);
SLfree ((char *) r);
}
/* reverse index converter from John Davis */
static SLang_Array_Type *convert_reverse_indices (SLindex_Type *r, SLindex_Type num_r, SLindex_Type num_h)
{
SLang_Array_Type *new_r;
SLang_Array_Type **new_r_data;
SLindex_Type i, *lens;
if (NULL == (new_r = SLang_create_array (SLANG_ARRAY_TYPE, 0, NULL, &num_h, 1)))
return NULL;
if (NULL == (lens = (SLindex_Type *)SLmalloc (num_h * sizeof (SLindex_Type))))
{
SLang_free_array (new_r);
return NULL;
}
memset ((char *)lens, 0, num_h*sizeof(SLindex_Type));
for (i = 0; i < num_r; i++)
{
SLindex_Type r_i = r[i];
if (r_i >= 0)
lens[r_i]++;
}
new_r_data = (SLang_Array_Type **) new_r->data;
for (i = 0; i < num_h; i++)
{
if (NULL == (new_r_data[i] = SLang_create_array (SLANG_ARRAY_INDEX_TYPE, 0, NULL, &lens[i], 1)))
goto return_error;
lens[i] = 0;
}
for (i = 0; i < num_r; i++)
{
SLang_Array_Type *at;
SLindex_Type r_i = r[i];
if (r_i < 0)
continue;
at = new_r_data[r_i];
((SLindex_Type *)at->data)[lens[r_i]] = i;
lens[r_i]++;
}
SLfree ((char *)lens);
return new_r;
return_error:
SLfree ((char *) lens);
SLang_free_array (new_r);
return NULL;
}
static int arith_bin_op (int op,
SLtype a_type, VOID_STAR ap, unsigned int na,
SLtype b_type, VOID_STAR bp, unsigned int nb,
VOID_STAR cp)
{
Bin_Fun_Type binfun;
int c_indx;
SLtype c_type;
if ((a_type == b_type)
&& ((a_type == SLANG_CHAR_TYPE) || (a_type == SLANG_UCHAR_TYPE)))
{
switch (op)
{
case SLANG_EQ:
case SLANG_NE:
case SLANG_AND:
case SLANG_OR:
return char_char_arith_bin_op (op, a_type, ap, na, b_type, bp, nb, cp);
}
}
c_type = promote_to_common_type (a_type, b_type);
c_indx = TYPE_TO_TABLE_INDEX(c_type);
binfun = Bin_Fun_Map[c_indx];
if ((c_type != a_type) || (c_type != b_type))
{
int ret;
int a_indx = TYPE_TO_TABLE_INDEX(a_type);
int b_indx = TYPE_TO_TABLE_INDEX(b_type);
Convert_Fun_Type af = Binary_Matrix[a_indx][c_indx].convert_function;
Convert_Fun_Type bf = Binary_Matrix[b_indx][c_indx].convert_function;
if ((af != NULL)
&& (NULL == (ap = (VOID_STAR) (*af) (ap, na))))
return -1;
if ((bf != NULL)
&& (NULL == (bp = (VOID_STAR) (*bf) (bp, nb))))
{
if (af != NULL) SLfree ((char *) ap);
return -1;
}
ret = (*binfun) (op, a_type, ap, na, b_type, bp, nb, cp);
if (af != NULL) SLfree ((char *) ap);
if (bf != NULL) SLfree ((char *) bp);
return ret;
}
return (*binfun) (op, a_type, ap, na, b_type, bp, nb, cp);
}
static void reset_smg (void)
{
unsigned int i;
if (Smg_Inited == 0)
return;
for (i = 0; i < Screen_Rows; i++)
{
SLfree ((char *)SL_Screen[i].old);
SLfree ((char *)SL_Screen[i].neew);
SL_Screen[i].old = SL_Screen[i].neew = NULL;
}
This_Alt_Char = This_Color = 0;
Smg_Inited = 0;
}
static void delete_chunk (Chunk_Type *c)
{
unsigned int i, n;
SLang_Object_Type *objs;
if (c == NULL)
return;
n = c->num_elements;
objs = c->elements;
for (i = 0; i < n; i++)
SLang_free_object (objs+i);
SLfree ((char *) objs);
SLfree ((char *) c);
}
static int push_values_array (Values_Array_Type *av, int allow_empty_array)
{
SLang_Array_Type *at;
char **new_values;
if (av->num == 0)
{
if (allow_empty_array == 0)
return SLang_push_null ();
SLfree ((char *) av->values);
av->values = NULL;
}
else
{
if (NULL == (new_values = (char **)SLrealloc ((char *)av->values, av->num*sizeof(char *))))
return -1;
av->values = new_values;
}
av->num_allocated = av->num;
at = SLang_create_array (SLANG_STRING_TYPE, 0, av->values, &av->num, 1);
if (at == NULL)
return -1;
av->num_allocated = 0;
av->num = 0;
av->values = NULL;
return SLang_push_array (at, 1);
}
int input_new_helptopic(struct dsc$descriptor_s *newtopic, /*{{{*/
struct dsc$descriptor_s *prompt,
unsigned int *len_newtopic)
{
char *newtop, prompt_buf[256];
int dofree;
strncpy(prompt_buf,prompt->dsc$a_pointer,prompt->dsc$w_length);
prompt_buf[prompt->dsc$w_length] = 0;
newtop = "";
dofree = 0;
if ((SLang_run_hooks("vms_help_newtopic", 1, prompt_buf + 2) > 0)
&& (0 == SLpop_string (&newtop)))
dofree = 1;
strcpy (newtopic->dsc$a_pointer, newtop);
*len_newtopic = newtopic->dsc$w_length = strlen (newtop);
newtopic->dsc$b_dtype = DSC$K_DTYPE_T;
newtopic->dsc$b_class = DSC$K_CLASS_S;
if (dofree) SLfree(newtop);
return(1); /* should add codes that LIB$GET_INPUT can return */
}
void SLang_free_ref (SLang_Ref_Type *ref)
{
if (ref == NULL)
return;
if (ref->num_refs > 1)
{
ref->num_refs--;
return;
}
if (ref->destroy != NULL)
(*ref->destroy)(ref->data);
SLfree ((char *)ref->data);
SLfree ((char *)ref);
}
static Host_Addr_Info_Type *alloc_host_addr_info (unsigned int num, int h_length)
{
Host_Addr_Info_Type *hinfo;
size_t nbytes;
char *buf;
unsigned int i;
hinfo = (Host_Addr_Info_Type *) SLcalloc (1, sizeof (Host_Addr_Info_Type));
if (hinfo == NULL)
return NULL;
/* We need memory to hold num (char *) addresses + num*h_length bytes */
nbytes = num * sizeof(char *) + num * h_length;
if (NULL == (buf = (char *)SLmalloc (nbytes)))
{
SLfree ((char *)hinfo);
return NULL;
}
hinfo->h_addr_list = (char **)buf;
buf += num*sizeof(char *);
for (i = 0; i < num; i++)
{
hinfo->h_addr_list[i] = buf;
buf += h_length;
}
hinfo->num = num;
hinfo->h_length = h_length;
return hinfo;
}
int SLrline_set_line (SLrline_Type *rli, SLFUTURE_CONST char *buf)
{
unsigned int len;
if (rli == NULL)
return -1;
if (buf == NULL)
buf = "";
len = strlen (buf);
buf = SLmake_string (buf);
if (buf == NULL)
return -1;
SLfree ((char *)rli->buf);
rli->buf = (unsigned char *)buf;
rli->buf_len = len;
rli->point = len;
rli->len = len;
rli->state = RLI_LINE_SET;
return 0;
}
int SLang_pop_complex (double *r, double *i)
{
double *c;
switch (SLang_peek_at_stack ())
{
case SLANG_COMPLEX_TYPE:
if (-1 == SLclass_pop_ptr_obj (SLANG_COMPLEX_TYPE, VOID_STAR_STAR(&c)))
return -1;
*r = c[0];
*i = c[1];
SLfree ((char *) c);
break;
default:
*i = 0.0;
if (-1 == SLang_pop_double (r))
return -1;
break;
case -1:
return -1;
}
return 0;
}
static void free_png_type (Png_Type *p)
{
if (p == NULL)
return;
if (p->png != NULL)
{
if (p->mode == 'r')
{
if (p->info != NULL)
png_destroy_read_struct (&p->png, &p->info, NULL);
else
png_destroy_read_struct (&p->png, NULL, NULL);
}
else
{
if (p->info != NULL)
png_destroy_write_struct (&p->png, &p->info);
else
png_destroy_write_struct (&p->png, NULL);
}
}
if (p->fp != NULL)
fclose (p->fp);
SLfree ((char *) p);
}
void _pSLbstring_foreach_close (SLtype type, SLang_Foreach_Context_Type *c)
{
(void) type;
if (c == NULL) return;
SLbstring_free (c->bstr);
SLfree ((char *) c);
}
/* This function gets called when the fclose intrinsic is called on an fdopen
* derived object.
*/
void _pSLfclose_fdopen_fp (SLang_MMT_Type *mmt)
{
SLFile_FD_Type *f;
f = FD_Type_List;
while (f != NULL)
{
Stdio_MMT_List_Type *prev, *curr;
prev = NULL;
curr = f->stdio_mmt_list;
while (curr != NULL)
{
if (curr->stdio_mmt != mmt)
{
prev = curr;
curr = curr->next;
continue;
}
if (prev == NULL)
f->stdio_mmt_list = curr->next;
else
prev->next = curr->next;
SLang_free_mmt (mmt);
SLfree ((char *) curr);
return;
}
f = f->next;
}
}
static void free_image_pointers (png_byte **image_pointers)
{
if (image_pointers == NULL)
return;
SLfree ((char *) image_pointers);
}
static SLang_Foreach_Context_Type *
cl_foreach_open (SLtype type, unsigned int num)
{
SLang_Foreach_Context_Type *c;
(void) type;
if (num != 0)
{
_pSLang_verror (SL_NOT_IMPLEMENTED,
"%s does not support 'foreach using' form",
SLclass_get_datatype_name (type));
return NULL;
}
if (NULL == (c = (SLang_Foreach_Context_Type *) SLcalloc (1, sizeof (SLang_Foreach_Context_Type))))
return NULL;
if (-1 == pop_list (&c->list))
{
SLfree ((char *) c);
return NULL;
}
return c;
}
char *_pSLpath_find_file (SLFUTURE_CONST char *file, int signal_error)
{
SLFUTURE_CONST char *path;
char *dirfile;
if (file == NULL)
return NULL;
path = Load_Path;
if ((path == NULL) || (*path == 0))
path = ".";
dirfile = find_file (path, file);
if (dirfile != NULL)
{
file = SLang_create_slstring (dirfile);
SLfree (dirfile);
return (char *) file;
}
if (signal_error)
_pSLang_verror (SL_OBJ_NOPEN, "Unable to locate %s on load path", file);
return NULL;
}
static void cl_foreach_close (SLtype type, SLang_Foreach_Context_Type *c)
{
(void) type;
if (c == NULL) return;
free_list (c->list);
SLfree ((char *) c);
}
SLFile_FD_Type *SLfile_create_fd (SLFUTURE_CONST char *name, int fd)
{
SLFile_FD_Type *f;
if (name == NULL)
name = "";
if (NULL == (f = (SLFile_FD_Type *) SLmalloc (sizeof (SLFile_FD_Type))))
return NULL;
memset ((char *) f, 0, sizeof (SLFile_FD_Type));
if (NULL == (f->name = SLang_create_slstring (name)))
{
SLfree ((char *)f);
return NULL;
}
f->fd = fd;
f->num_refs = 1;
f->clientdata_id = 0;
f->clientdata = NULL;
/* If NULL, use the standard routines on a file descriptor */
f->close = NULL;
f->read = NULL;
f->write = NULL;
chain_fd_type (f);
return f;
}
static void chksum_close (Chksum_Object_Type *obj)
{
unsigned char *digest;
unsigned int digest_len;
SLChksum_Type *c;
if (NULL == (c = obj->c))
{
(void) SLang_push_null ();
return;
}
digest_len = c->digest_len;
if (NULL == (digest = (unsigned char *)SLmalloc(2*digest_len+1)))
return;
if (-1 == c->close (c, digest))
{
SLfree ((char *)digest);
return;
}
obj->c = NULL;
hexify_string (digest, digest_len);
(void) SLang_push_malloced_string ((char *)digest);
}
int SLrline_init (SLFUTURE_CONST char *appname, SLFUTURE_CONST char *user_initfile, SLFUTURE_CONST char *sys_initfile)
{
#ifdef __WIN32__
char *home_dir = getenv ("USERPROFILE");
#else
# ifdef VMS
char *home_dir = "SYS$LOGIN:"******"HOME");
# endif
#endif
char *file = NULL;
int status;
static char *appname_malloced;
if (sys_initfile == NULL)
sys_initfile = SLRLINE_SYS_INIT_FILE;
if (user_initfile == NULL)
user_initfile = SLRLINE_USER_INIT_FILE;
if (appname == NULL)
appname = "Unknown";
if (NULL == (appname_malloced = SLmake_string (appname)))
return -1;
if (-1 == SLadd_intrinsic_variable ("__RL_APP__", &appname_malloced, SLANG_STRING_TYPE, 1))
return -1;
if (-1 == SLadd_intrin_fun_table (Intrinsics, NULL))
return -1;
if (-1 == init_keymap ())
return -1;
if (user_initfile != NULL)
{
file = SLpath_find_file_in_path (home_dir, user_initfile);
if (file != NULL)
{
status = SLns_load_file (file, NULL);
SLfree (file);
return status;
}
}
if (sys_initfile != NULL)
{
file = _pSLpath_find_file (sys_initfile, 0);
if (file != NULL)
{
status = SLns_load_file (file, NULL);
SLang_free_slstring (file);
return status;
}
}
return 0;
}