static int parse_file (char *file)
{
char buf[512];
FILE *fp;
if (NULL == (fp = fopen (file, "r")))
return 1;
Cmd_Table.table = Startup_File_Cmds;
Line_Num = 0;
while (NULL != fgets (buf, sizeof (buf), fp))
{
Line_Num++;
(void) SLcmd_execute_string (buf, &Cmd_Table);
if (SLang_get_error())
parse_error ("Undefined keyword");
}
fclose (fp);
if (SLang_get_error ())
{
SLang_set_error(0);
return -1;
}
return 0;
}
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);
}
/*{{{ exit_jed */
int jed_exit_jed (int status)
{
static int in_exit_jed = 0;
if (in_exit_jed == 0)
{
in_exit_jed = 1;
if (jed_va_run_hooks ("_jed_exit_hooks", JED_HOOKS_RUN_UNTIL_0, 0) <= 0)
{
in_exit_jed = 0;
return -1;
}
}
in_exit_jed = 0;
if (SLang_get_error ())
return -1;
#if JED_HAS_SUBPROCESSES
if (1 != jed_processes_ok_to_exit ())
return 1;
#endif
if (save_some_buffers() > 0) jed_quit_jed(status);
return 1;
}
int slsh_interactive (void)
{
Slsh_Quit = 0;
(void) SLang_add_cleanup_function (close_interactive);
if (-1 == open_interactive ())
return -1;
(void) SLang_run_hooks ("slsh_interactive_hook", 0);
while (Slsh_Quit == 0)
{
if (SLang_get_error ())
{
SLang_restart(1);
/* SLang_set_error (0); */
}
SLKeyBoard_Quit = 0;
SLang_load_object (Readline_Load_Object);
}
close_interactive ();
return 0;
}
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;
}
/*{{{ quoted_insert */
int quoted_insert()
{
SLwchar_Type ch;
int ins_byte = 1;
CHECK_READ_ONLY
if (*Error_Buffer || SLKeyBoard_Quit) return(0);
if (Repeat_Factor != NULL)
{
ch = *Repeat_Factor;
ins_byte = 0;
Repeat_Factor = NULL;
}
else
{
SLang_Key_TimeOut_Flag = 1;
ch = jed_getkey();
SLang_Key_TimeOut_Flag = 0;
}
if (SLang_get_error () == SL_USER_BREAK)
SLang_set_error (0);
if ((ch == '\n') && (CBuf == MiniBuffer))
{
(void) _jed_ins_byte ('\n');
/* msg_error("Not allowed!"); */
return (1);
}
SLKeyBoard_Quit = 0;
if (ins_byte == 0)
{
if (-1 == jed_insert_wchar_n_times(ch, 1))
return -1;
}
else
{
unsigned char byte = (unsigned char) ch;
if (-1 == jed_insert_nbytes (&byte, 1))
return -1;
}
if ((CBuf->syntax_table != NULL)
&& (CBuf->syntax_table->char_syntax[(unsigned char) ch] & CLOSE_DELIM_SYNTAX)
&& !input_pending(&Number_Zero)) blink_match (); /* (ch); */
return(1);
}
static char *read_using_readline (SLang_Load_Type *x)
{
char *s;
static char *last_s;
if (last_s != NULL)
{
SLfree (last_s);
last_s = NULL;
}
if (SLang_get_error ())
return NULL;
SLKeyBoard_Quit = 0;
s = get_input_line (x);
if (s == NULL)
return NULL;
if ((x->parse_level == 0)
&& (1 == SLang_run_hooks ("slsh_interactive_massage_hook", 1, s)))
{
SLfree (s);
if (-1 == SLpop_string (&s))
return NULL;
}
if (SLang_get_error ())
{
SLfree (s);
return NULL;
}
last_s = s;
return s;
}
static int get_hostname_info (void)
{
char *host;
host = get_hostname ();
if (host != NULL)
{
if (-1 == set_hostname (host))
{
SLang_free_slstring (host);
return -1;
}
SLang_free_slstring (host);
return 0;
}
if (SLang_get_error ())
return -1;
return set_hostname ("localhost");
}
/* I malloc one extra so that I can always add a null character to last line */
char *vgets(VFILE *vp, unsigned int *num) /*{{{*/
{
register char *bp, *bp1;
register char *bmax, *bpmax;
char *neew;
int fd = vp->fd;
unsigned int n, max, fmode = vp->mode;
int doread = 0;
n = vp->size;
*num = 0;
if (NULL == vp->buf)
{
#if defined (__MSDOS_16BIT__)
if (!n) n = 512;
#else
if (!n) n = 64 * 1024;
#endif
if (NULL == (neew = SLmalloc(n + 1)))
return NULL;
vp->bp = vp->buf = neew;
vp->bmax = neew + n;
doread = 1;
}
bp = vp->bp;
if ((vp->eof != NULL) && (bp >= vp->eof)) return (NULL);
bp1 = vp->buf;
bmax = vp->bmax;
while (1)
{
if (doread)
{
max = (int) (vp->bmax - bp);
while (max > 0)
{
int nread;
nread = read(fd, bp, max);
if (nread == 0)
break;
if (nread == -1)
{
if (SLKeyBoard_Quit || (SLang_get_error () == SL_USER_BREAK))
break;
#if defined(__WIN32__) && (defined(_MSC_VER) || defined(__BORLANDC__))
# ifdef EPIPE
if (errno == EPIPE)
break;
# endif
#endif
#ifndef IBMPC_SYSTEM
# ifdef EINTR
if (errno == EINTR)
{
if (-1 == jed_handle_interrupt ())
break;
continue;
}
# endif
# ifdef EAGAIN
if (errno == EAGAIN)
{
if (-1 == jed_handle_interrupt ())
break;
sleep (1);
continue;
}
# endif
#endif
return NULL;
}
max -= nread;
bp += nread;
}
if (max) vp->eof = bp;
if (bp == bp1)
{
return(NULL);
}
bp = bp1;
}
else bp1 = bp;
/* extract a line */
if (vp->eof != NULL) bmax = vp->eof;
n = (unsigned int) (bmax - bp);
#if defined(__MSDOS__)
if (n)
{
bpmax = bp;
#if defined(__BORLANDC__) && !defined(__WIN32__)
asm {
mov bx, di
mov al, 10
mov cx, n
les di, bpmax
cld
repne scasb
inc cx
sub n, cx
mov di, bx
}
bp += n;
#else
if (NULL == (bpmax = SLMEMCHR(bp, '\n', n)))
bp += n;
else
bp = bpmax;
#endif /* __WIN32__ */
if (*bp != '\n') bp++;
}
if (bp < bmax)
{
vp->bp = ++bp;
*num = (unsigned int) (bp - bp1);
/* if it is text, replace the carriage return by a newline
and adjust the number read by 1 */
bp -= 2;
if ((fmode == VFILE_TEXT) && (*num > 1) && (*bp == '\r'))
{
*bp = '\n';
*num -= 1;
vp->cr_flag = 1;
}
return bp1;
}
#else
if (NULL != (bpmax = SLMEMCHR(bp, '\n', n)))
{
bpmax++;
vp->bp = bpmax;
*num = (unsigned int) (bpmax - bp1);
if ((fmode == VFILE_TEXT) && (*num > 1))
{
bpmax -= 2;
if (*bpmax == '\r')
{
vp->cr_flag = 1;
*bpmax = '\n'; (*num)--;
}
}
return bp1;
}
bp = bp + n;
#endif /* __MSDOS__ */
if (vp->eof != NULL)
{
*num = (unsigned int) (bp - bp1);
vp->bp = bp;
#if defined(IBMPC_SYSTEM)
/* kill ^Z at EOF if present */
if ((fmode == VFILE_TEXT) && (*num) && (26 == *(bp - 1)))
{
*num -= 1;
if (!*num) bp1 = NULL;
}
#endif
return(bp1);
}
doread = 1;
bp = bp1;
bp1 = vp->buf;
if (bp != bp1)
{
/* shift to beginning */
while (bp < bmax) *bp1++ = *bp++;
bp = bp1;
bp1 = vp->buf;
}
else
{
bp = bmax;
vp->bmax += 2 * (int) (vp->bmax - vp->buf);
neew = SLrealloc (vp->buf, 1 + (unsigned int) (vp->bmax - vp->buf));
if (neew == NULL)
return NULL;
bp = neew + (int) (bmax - vp->buf);
bmax = vp->bmax = neew + (int) (vp->bmax - vp->buf);
bp1 = vp->buf = neew;
}
}
}
int main (int argc, char **argv)
{
int i;
int utf8 = 0;
for (i = 1; i < argc; i++)
{
char *arg = argv[i];
if (*arg != '-')
break;
if (0 == strcmp (arg, "-utf8"))
{
utf8 = 1;
continue;
}
i = argc;
}
if (i >= argc)
{
fprintf (stderr, "Usage: %s [-utf8] FILE...\n", argv[0]);
return 1;
}
(void) SLutf8_enable (utf8);
if ((-1 == SLang_init_all ())
|| (-1 == SLang_init_array_extra ())
|| (-1 == SLadd_intrin_fun_table (Intrinsics, NULL))
|| (-1 == add_test_classes ()))
return 1;
SLang_Traceback = 1;
if (-1 == SLang_set_argc_argv (argc, argv))
return 1;
#ifdef HAVE_FPSETMASK
# ifndef FP_X_OFL
# define FP_X_OFL 0
# endif
# ifndef FP_X_INV
# define FP_X_INV 0
# endif
# ifndef FP_X_DZ
# define FP_X_DZ 0
# endif
# ifndef FP_X_DNML
# define FP_X_DNML 0
# endif
# ifndef FP_X_UFL
# define FP_X_UFL 0
# endif
# ifndef FP_X_IMP
# define FP_X_IMP 0
# endif
fpsetmask (~(FP_X_OFL|FP_X_INV|FP_X_DZ|FP_X_DNML|FP_X_UFL|FP_X_IMP));
#endif
if (i + 1 < argc)
Ignore_Exit = 1;
while (i < argc)
{
char *file = argv[i];
if (0 == strncmp (SLpath_extname (file), ".slc", 4))
{
char *file_sl = SLmake_string (file);
file_sl[strlen(file_sl)-1] = 0;
if (-1 == SLang_byte_compile_file (file_sl, 0))
{
SLfree (file_sl);
return 1;
}
SLfree (file_sl);
}
if (-1 == SLang_load_file (file))
return 1;
i++;
}
return SLang_get_error ();
}
static int slfe_optimize (Isis_Fit_Type *ift, void *clientdata, /*{{{*/
double *x, double *y, double *weights, unsigned int npts,
double *pars, unsigned int npars)
{
Isis_Fit_Engine_Type *e;
SLang_Array_Type *sl_pars=NULL, *sl_pars_min=NULL, *sl_pars_max=NULL;
SLang_Array_Type *sl_new_pars=NULL;
SLindex_Type n;
int status = -1;
(void) clientdata; (void) x; (void) y; (void) weights; (void) npts;
if ((ift == NULL) || (pars == NULL) || (npars <= 0)
|| (Current_Fit_Object_MMT == NULL))
return -1;
e = ift->engine;
n = (SLindex_Type) npars;
sl_pars = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &n, 1);
sl_pars_min = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &n, 1);
sl_pars_max = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &n, 1);
if ((NULL == sl_pars) || (NULL == sl_pars_min) || (NULL == sl_pars_max))
return -1;
memcpy ((char *)sl_pars->data, (char *)pars, npars * sizeof(double));
memcpy ((char *)sl_pars_min->data, (char *)e->par_min, npars * sizeof(double));
memcpy ((char *)sl_pars_max->data, (char *)e->par_max, npars * sizeof(double));
/* FIXME: Increment the reference count to prevent a segv.
* There must be a better way.
*/
SLang_inc_mmt (Current_Fit_Object_MMT);
SLang_start_arg_list ();
if ((-1 == SLang_push_mmt (Current_Fit_Object_MMT))
|| (-1 == SLang_push_array (sl_pars, 1))
|| (-1 == SLang_push_array (sl_pars_min, 1))
|| (-1 == SLang_push_array (sl_pars_max, 1)))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"calling user-defined optimization method '%s'",
e->engine_name);
goto return_error;
}
SLang_end_arg_list ();
if (-1 == SLexecute_function (e->sl_optimize))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"executing optimization method '%s'",
e->engine_name);
goto return_error;
}
if (-1 == SLang_pop_array_of_type (&sl_new_pars, SLANG_DOUBLE_TYPE))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"returning results from optimization method '%s'",
e->engine_name);
goto return_error;
}
if ((sl_new_pars == NULL) || (sl_new_pars->num_elements != npars))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__,
"corrupted parameter array returned from optimization method '%s'",
e->engine_name);
goto return_error;
}
memcpy ((char *)pars, (char *)sl_new_pars->data, npars * sizeof(double));
status = 0;
return_error:
SLang_free_array (sl_new_pars);
if (SLang_get_error())
{
isis_throw_exception (SLang_get_error());
return -1;
}
return status;
}
static int slfe_set_options (Isis_Fit_Engine_Type *e, Isis_Option_Type *opts) /*{{{*/
{
SLang_Array_Type *sl_opts;
SLindex_Type i, n;
if (opts == NULL)
return -1;
n = opts->num_options;
if (n == 0)
return 0;
if (NULL == (sl_opts = SLang_create_array (SLANG_STRING_TYPE, 1, NULL, &n, 1)))
return -1;
for (i = 0; i < n; i++)
{
int have_value = (opts->option_values[i] != 0);
char *s;
if (have_value)
{
s = isis_mkstrcat (opts->option_names[i], "=",
opts->option_values[i], NULL);
}
else s = opts->option_names[i];
if ((s == NULL)
|| (-1 == SLang_set_array_element (sl_opts, &i, &s)))
{
SLang_free_array (sl_opts);
if (have_value) ISIS_FREE(s);
}
if (have_value) ISIS_FREE(s);
}
SLang_start_arg_list();
(void) SLang_push_array (sl_opts, 1);
SLang_end_arg_list();
/* converts options array to a struct */
SLang_execute_function ("_isis->options_to_struct");
/* this function then pops the struct off the stack */
if (-1 == SLexecute_function (e->sl_set_options))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"setting options for fit method '%s'",
e->engine_name);
return -1;
}
if (SLang_get_error ())
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"S-Lang error while setting options for fit method '%s'",
e->engine_name);
return -1;
}
return 0;
}
/* This routine is a mess and it, do_dialog, and the Mini_Ghost flag needs
* to be totally redesigned.
*/
void update(Line *line, int force, int flag, int run_update_hook)
{
int pc_flag = 1;
int col;
static unsigned long last_time;
Line *hscroll_line_save;
if (0 == Jed_Display_Initialized)
return;
#if JED_HAS_SUBPROCESSES
if (Child_Status_Changed_Flag)
{
jed_get_child_status ();
force = 1;
}
#endif
if (Batch) return;
if (!force && !SLang_get_error () && !SLKeyBoard_Quit && (!*Error_Buffer))
{
if (screen_input_pending (0))
{
JWindow->trashed = 1;
return;
}
}
if (last_time + 30 < Status_This_Time)
{
if (last_time == 0) last_time = Status_This_Time;
else
{
last_time = Status_This_Time;
if (SLang_run_hooks ("update_timer_hook", 0))
flag = 0;
}
}
if (run_update_hook
&& (CBuf->buffer_hooks != NULL)
&& (CBuf->buffer_hooks->update_hook != NULL)
&& (SLang_get_error () == 0))
{
Suspend_Screen_Update = 1;
SLexecute_function (CBuf->buffer_hooks->update_hook);
if (SLang_get_error ()) CBuf->buffer_hooks->update_hook = NULL;
}
if (Suspend_Screen_Update != 0)
{
Suspend_Screen_Update = 0;
touch_screen ();
}
if (X_Update_Open_Hook != NULL) (*X_Update_Open_Hook) ();
#ifdef FIX_CHAR_WIDTH
FIX_CHAR_WIDTH;
#endif
col = calculate_column ();
HScroll_Line = NULL;
if (Wants_HScroll) set_hscroll(col); else HScroll = 0;
hscroll_line_save = HScroll_Line;
if (SLang_get_error ()) flag = 0; /* update hook invalidates flag */
if (SLang_get_error () && !(*Error_Buffer || SLKeyBoard_Quit))
{
SLang_verror (0, "%s", SLerr_strerror (0));
}
if (!flag && (*Error_Buffer || SLKeyBoard_Quit))
{
do_dialog(Error_Buffer);
#if 0
SLKeyBoard_Quit = 0;
SLang_restart(0);
SLang_set_error (0);
#endif
Mini_Ghost = 1;
(void) update_1(line, 1);
update_minibuffer();
}
else if ((flag == 0) && *Message_Buffer)
{
if (!update_1(line, force))
goto done;
do_dialog(Message_Buffer);
Mini_Ghost = 1;
update_minibuffer();
}
else
{
pc_flag = JWindow->trashed || (JWindow != JWindow->next) || Cursor_Motion;
if (!flag) update_minibuffer();
if (!update_1(line, force)) goto done;
}
if (!flag) *Error_Buffer = *Message_Buffer = 0;
#if JED_HAS_MENUS
update_top_screen_line ();
#else
if ((Top_Window_SY > 0) && JScreen[0].is_modified)
{
update_top_screen_line ();
}
#endif
done:
HScroll_Line = hscroll_line_save;
if (MiniBuf_Get_Response_String != NULL)
{
do_dialog (MiniBuf_Get_Response_String);
Mini_Ghost = 1;
}
else if (Point_Cursor_Flag || pc_flag)
point_cursor(col);
if (X_Update_Close_Hook != NULL) (*X_Update_Close_Hook) ();
SLsmg_refresh ();
}
/* 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;
}
