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 void slfe_deallocate (Isis_Fit_Engine_Type *e) /*{{{*/
{
ISIS_FREE (e->engine_name);
ISIS_FREE (e->default_statistic_name);
ISIS_FREE (e->option_string);
SLang_free_function (e->sl_optimize);
SLang_free_function (e->sl_set_options);
}
static void set_bof_eof_handlers (SLang_Name_Type *bof, SLang_Name_Type *eof)
{
if (BOF_Callback_Handler != NULL)
SLang_free_function (BOF_Callback_Handler);
BOF_Callback_Handler = bof;
if (EOF_Callback_Handler != NULL)
SLang_free_function (EOF_Callback_Handler);
EOF_Callback_Handler = eof;
}
static void set_bos_eos_handlers (SLang_Name_Type *bos, SLang_Name_Type *eos)
{
if (BOS_Callback_Handler != NULL)
SLang_free_function (BOS_Callback_Handler);
BOS_Callback_Handler = bos;
if (EOS_Callback_Handler != NULL)
SLang_free_function (EOS_Callback_Handler);
EOS_Callback_Handler = eos;
}
static void free_cb_info (Rline_CB_Type *cb)
{
if (cb == NULL)
return;
if (cb->mmt != NULL) SLang_free_mmt (cb->mmt);
if (cb->update_hook != NULL) SLang_free_function (cb->update_hook);
if (cb->clear_cb != NULL) SLang_free_function (cb->clear_cb);
if (cb->preread_cb != NULL) SLang_free_function (cb->preread_cb);
if (cb->postread_cb != NULL) SLang_free_function (cb->postread_cb);
if (cb->width_cb != NULL) SLang_free_function (cb->width_cb);
if (cb->cd != NULL) SLang_free_anytype (cb->cd);
SLfree ((char *)cb);
}
void isis_fit_free_fit_statistic (Isis_Fit_Statistic_Type *s) /*{{{*/
{
if (s == NULL)
return;
if (s->deallocate != NULL)
s->deallocate (s);
if (s->sl_fun != NULL)
SLang_free_function (s->sl_fun);
if (s->sl_report != NULL)
SLang_free_function (s->sl_report);
ISIS_FREE (s->symbol);
ISIS_FREE (s);
}
static void rline_set_list_completions_callback (void)
{
SLang_Name_Type *nt;
if (NULL == (nt = SLang_pop_function ()))
return;
if (Active_Rline_Info == NULL)
{
SLang_free_function (Default_List_Completions_Callback);
Default_List_Completions_Callback = nt;
return;
}
SLang_free_function (Active_Rline_Info->list_completions_callback);
Active_Rline_Info->list_completions_callback = nt;
}
/* On stack: (rli, callback) */
static int pop_set_rline_cb_args (SLang_MMT_Type **mmtp,
Rline_CB_Type **cbp, SLang_Name_Type **ntp)
{
SLang_Name_Type *nt;
Slsh_Readline_Type *sri;
SLang_MMT_Type *mmt;
if (SLang_peek_at_stack () == SLANG_NULL_TYPE)
nt = NULL;
else if (NULL == (nt = SLang_pop_function ()))
return -1;
if (NULL == (mmt = pop_sri_type (&sri)))
{
if (nt != NULL)
SLang_free_function (nt);
return -1;
}
if (-1 == SLrline_get_update_client_data (sri->rli, (VOID_STAR *)cbp))
goto return_error;
if (*cbp == NULL)
{
SLang_verror (SL_Application_Error, "\
Attempt to define an rline update callback without first creating a readline_update_hook");
goto return_error;
}
static void free_csv_type (CSV_Type *csv)
{
if (csv == NULL)
return;
if (csv->callback_data != NULL) SLang_free_anytype (csv->callback_data);
if (csv->read_callback != NULL) SLang_free_function (csv->read_callback);
SLfree ((char *)csv);
}
static void set_verb_warn_func (void)
{
SLang_Name_Type *sf;
if (NULL == (sf = SLang_pop_function ()))
return;
if (Verb_Warn_Func != NULL)
SLang_free_function (Verb_Warn_Func);
Verb_Warn_Func = sf;
}
static Isis_Fit_Statistic_Type *init_sl_statistic (void) /*{{{*/
{
SLang_Name_Type *statistic_fun, *report_fun;
Isis_Fit_Statistic_Type *s;
if (NULL == (s = (Isis_Fit_Statistic_Type *) ISIS_MALLOC (sizeof(Isis_Fit_Statistic_Type))))
return NULL;
memset ((char *)s, 0, sizeof (*s));
if (NULL == (report_fun = SLang_pop_function ()))
{
ISIS_FREE (s);
return NULL;
}
if (NULL == (statistic_fun = SLang_pop_function ()))
{
ISIS_FREE (s);
SLang_free_function (report_fun);
return NULL;
}
if (NULL == (s->symbol = isis_make_string (statistic_fun->name)))
{
ISIS_FREE(s);
SLang_free_function (report_fun);
SLang_free_function (statistic_fun);
return NULL;
}
s->compute_statistic = sl_statistic_function;
s->deallocate = sl_deallocate_function;
s->report = sl_report_function;
s->sl_fun = statistic_fun;
s->sl_report = report_fun;
return s;
}
static int pop_new_push_old (SLang_Name_Type **handler)
{
SLang_Name_Type *new_handler;
SLang_Name_Type *old_handler;
old_handler = *handler;
if (SLang_peek_at_stack () == SLANG_NULL_TYPE)
{
SLang_pop_null ();
new_handler = NULL;
}
else if (NULL == (new_handler = SLang_pop_function ()))
return -1;
if (-1 == _pSLang_push_nt_as_ref (old_handler))
{
SLang_free_function (new_handler);
return -1;
}
SLang_free_function (old_handler);
*handler = new_handler;
return 0;
}
static void set_prompt_hook (void)
{
SLang_Name_Type *h;
if (SLang_peek_at_stack () == SLANG_NULL_TYPE)
{
SLang_pop_null ();
h = NULL;
}
else if (NULL == (h = SLang_pop_function ()))
return;
if (Prompt_Hook != NULL)
SLang_free_function (Prompt_Hook);
Prompt_Hook = h;
}
static void signal_intrinsic (void)
{
SLang_Name_Type *f;
Signal_Type *s;
void (*old_handler) (int);
SLang_Ref_Type *old_ref;
if (SLang_Num_Function_Args == 3)
{
if (-1 == SLang_pop_ref (&old_ref))
return;
}
else old_ref = NULL;
if (SLang_Num_Function_Args == 0)
{
SLang_verror (SL_Internal_Error, "signal called with 0 args");
return;
}
if (SLANG_INT_TYPE == SLang_peek_at_stack ())
{
int h;
if ((-1 == SLang_pop_int (&h))
|| (-1 == pop_signal (&s)))
{
SLang_free_ref (old_ref);
return;
}
/* If this signal has already been caught, deliver it now to the old handler */
if (s->pending)
handle_signal (s);
/* Note that the signal has the potential of being lost if the user has
* blocked its delivery. For this reason, the unblock_signal intrinsic
* will have to deliver the signal via an explicit kill if it is pending.
*/
if (h == SIG_IGN_CONSTANT)
old_handler = SLsignal_intr (s->sig, SIG_IGN);
else if (h == SIG_DFL_CONSTANT)
old_handler = SLsignal_intr (s->sig, SIG_DFL);
else if (h == SIG_APP_CONSTANT)
old_handler = SLsignal_intr (s->sig, s->c_handler);
else
{
SLang_free_ref (old_ref);
_pSLang_verror (SL_INVALID_PARM, "Signal handler '%d' is invalid", h);
return;
}
if (-1 == set_old_handler (s, old_ref, old_handler))
{
SLang_free_ref (old_ref);
return;
}
if (s->handler != NULL)
{
SLang_free_function (s->handler);
s->handler = NULL;
}
SLang_free_ref (old_ref);
return;
}
if (NULL == (f = SLang_pop_function ()))
{
SLang_free_ref (old_ref);
return;
}
if (-1 == pop_signal (&s))
{
SLang_free_ref (old_ref);
SLang_free_function (f);
return;
}
old_handler = SLsignal_intr (s->sig, signal_handler);
if (-1 == set_old_handler (s, old_ref, old_handler))
{
SLang_free_ref (old_ref);
SLang_free_function (f);
return;
}
if (s->handler != NULL)
SLang_free_function (s->handler);
s->handler = f;
SLang_free_ref (old_ref);
}
static void set_debug_hook (SLang_Name_Type *deb)
{
if (Debug_Hook != NULL)
SLang_free_function (Debug_Hook);
Debug_Hook = deb;
}
/* Returns a malloced value */
static char *get_input_line (SLang_Load_Type *x)
{
char *line;
int parse_level;
int free_prompt = 0;
char *prompt;
parse_level = x->parse_level;
if (Prompt_Hook != NULL)
{
if ((-1 == SLang_start_arg_list ())
|| (-1 == SLang_push_int (parse_level))
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (Prompt_Hook))
|| (-1 == SLang_pop_slstring (&prompt)))
{
SLang_verror (SL_RunTime_Error, "Disabling prompt hook");
SLang_free_function (Prompt_Hook);
Prompt_Hook = NULL;
return NULL;
}
free_prompt = 1;
}
else if (parse_level == 0)
prompt = (char *) "slsh> ";
else
prompt = (char *) " ";
if (parse_level == 0)
{
if (-1 == SLang_run_hooks ("slsh_interactive_before_hook", 0))
{
if (free_prompt)
SLang_free_slstring (prompt);
return NULL;
}
}
line = read_input_line (Default_Readline_Info, prompt, 0);
if (free_prompt)
SLang_free_slstring (prompt);
if ((line == NULL)
&& (parse_level == 0)
&& (SLang_get_error() == 0))
{
Slsh_Quit = 1;
return NULL;
}
if (line == NULL)
{
return NULL;
}
/* This hook is used mainly for logging input */
(void) SLang_run_hooks ("slsh_interactive_after_hook", 1, line);
(void) save_input_line (Default_Readline_Info, line);
return line;
}
