static void alarm_intrinsic (void)
{
#ifndef HAVE_ALARM
SLang_set_error (SL_NotImplemented_Error);
#else
SLang_Ref_Type *ref = NULL;
unsigned int secs;
Signal_Type *s;
if (SLang_Num_Function_Args == 2)
{
if (-1 == SLang_pop_ref (&ref))
return;
}
if (-1 == SLang_pop_uint (&secs))
{
SLang_free_ref (ref); /* NULL ok */
return;
}
#ifdef SIGALRM
if ((NULL != (s = find_signal (SIGALRM)))
&& s->forbidden)
{
SLang_set_error (SL_Forbidden_Error);
return;
}
#endif
secs = alarm (secs);
if (ref != NULL)
(void) SLang_assign_to_ref (ref, SLANG_UINT_TYPE, &secs);
#endif
}
static void sigsuspend_intrinsic (void)
{
#ifdef SLANG_POSIX_SIGNALS
sigset_t mask;
#endif
if (SLang_Num_Function_Args == 0)
{
#ifdef HAVE_PAUSE
(void) pause ();
#else
SLang_set_error (SL_NotImplemented_Error);
#endif
return;
}
#ifndef SLANG_POSIX_SIGNALS
SLang_set_error (SL_NotImplemented_Error);
#else
if (-1 == pop_signal_mask (&mask))
return;
(void) sigsuspend (&mask);
#endif
}
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;
}
static int pop_signal (Signal_Type **sp)
{
int sig;
Signal_Type *s;
if (-1 == SLang_pop_int (&sig))
return -1;
s = Signal_Table;
while (s->name != NULL)
{
if (s->sig == sig)
{
if (s->forbidden)
{
SLang_set_error (SL_Forbidden_Error);
return -1;
}
*sp = s;
return 0;
}
s++;
}
_pSLang_verror (SL_INVALID_PARM, "Signal %d invalid or unknown", sig);
return -1;
}
static void thread_getkey ()
{
KBDKEYINFO keyInfo;
int n;
while (!atEnd) { /* at end is a flag */
set_kbd();
KbdCharIn(&keyInfo, IO_NOWAIT, 0); /* get a character */
if (keyInfo.fbStatus & 0x040) { /* found a char process it */
if (keyInfo.chChar == SLang_Abort_Char) {
if (SLang_Ignore_User_Abort == 0) SLang_set_error (SL_USER_BREAK);
SLKeyBoard_Quit = 1;
}
n = (endBuf + 1) % BUFFER_LEN;
if (n == startBuf) {
DosBeep (500, 20);
KbdFlushBuffer(0);
continue;
}
RequestSem();
threadKeys [n].ascii = keyInfo.chChar;
threadKeys [n].scan = keyInfo.chScan;
/* threadKeys [n].shift = keyInfo.fsState; */
endBuf = n;
ReleaseSem();
} else /* no char available*/
DosSleep (20);
}
}
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;
}
void sl_ioctl (void)
{
char *argp = NULL;
int fd, retval;
unsigned int length, request;
SLFile_FD_Type *f;
SLang_BString_Type *bstr;
if (SLang_Num_Function_Args == 3)
{
if (SLang_pop_bstring (&bstr) == -1)
goto usage_error;
if (SLang_pop_uint ((unsigned int *) &request) == -1)
goto usage_error;
if (SLfile_pop_fd (&f) == -1)
goto usage_error;
argp = SLbstring_get_pointer (bstr, &length);
}
else if (SLang_Num_Function_Args == 2)
{
if (SLang_pop_uint ((unsigned int *) &request) == -1)
goto usage_error;
if (SLfile_pop_fd (&f) == -1)
goto usage_error;
}
else
goto usage_error;
if (SLfile_get_fd (f, &fd) == -1)
return;
if ((retval = ioctl (fd, request, argp)) == -1)
{
SLang_set_error (SL_OS_Error);
(void) SLerrno_set_errno (errno);
return;
}
(void) SLang_push_int (retval);
if (argp != NULL)
(void) SLang_push_bstring (bstr);
return;
usage_error :
SLang_set_error (SL_Usage_Error);
return;
}
static void default_sigint (int sig)
{
sig = errno; /* use parameter */
SLKeyBoard_Quit = 1;
if (SLang_Ignore_User_Abort == 0) SLang_set_error (SL_USER_BREAK);
SLsignal_intr (SIGINT, default_sigint);
errno = sig;
}
/* a control-G puts us here */
static void my_interrupt(int sig) /*{{{*/
{
sig = errno;
SLKeyBoard_Quit = 1;
if (Ignore_User_Abort == 0) SLang_set_error (SL_USER_BREAK);
SLsignal_intr (SIGINT, my_interrupt);
errno = sig;
}
static int rethrow_error (void)
{
Error_Context_Type *e = Error_Context;
if (e == NULL)
return 0;
SLang_set_error (e->err);
e->rethrow=1;
e->err_cleared = 0;
return 0;
}
/* this will be called with use_current_queue set to 0 if the catch block
* was processed with no error. If an error occurs processing the catch
* block, then that error will take precedence over the one triggering the
* catch block. However, if the original error is rethrown, then this routine
* will still be called with use_current_queue non-zero since all the caller
* knows is that an error occured and cannot tell if it was a rethrow.
*/
int _pSLang_pop_error_context (int use_current_queue)
{
Error_Context_Type *e;
e = Error_Context;
if (e == NULL)
return -1;
Error_Context = e->next;
if ((use_current_queue == 0) || (e->rethrow))
{
(void) _pSLerr_set_error_queue (e->err_queue);
_pSLerr_delete_error_queue (Error_Message_Queue);
Error_Message_Queue = e->err_queue;
free_thrown_object ();
if (e->object_was_thrown)
{
Object_Thrownp = &Object_Thrown;
Object_Thrown = e->object_thrown;
}
}
else
{
_pSLerr_delete_error_queue (e->err_queue);
if (e->object_was_thrown)
SLang_free_object (&e->object_thrown);
}
if (_pSLang_Error == 0)
{
if (e->err_cleared == 0)
{
SLang_free_slstring ((char *)File_With_Error);
SLang_free_slstring ((char *)Function_With_Error);
File_With_Error = e->file; e->file = NULL;
Function_With_Error = e->function; e->function = NULL;
Linenum_With_Error = e->linenum;
(void) SLang_set_error (e->err);
}
}
if (_pSLang_Error == SL_UserBreak_Error)
SLKeyBoard_Quit = 1;
SLang_free_slstring ((char *) e->file);
SLang_free_slstring ((char *) e->function);
SLfree ((char *) e);
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 int check_range_index (int len, int *ip)
{
int i = *ip;
if (i < 0)
i += len;
if ((i < 0) || (i >= len))
{
SLang_set_error (SL_Index_Error);
return -1;
}
*ip = i;
return 0;
}
int _pSLerr_throw (void)
{
int e;
int nargs = SLang_Num_Function_Args;
char *msg = NULL;
free_thrown_object ();
switch (nargs)
{
case 3:
if (-1 == SLang_pop (&Object_Thrown))
return -1;
Object_Thrownp = &Object_Thrown;
/* drop */
case 2:
if (-1 == SLang_pop_slstring (&msg))
{
free_thrown_object ();
return -1;
}
case 1:
/* drop */
if (-1 == _pSLerr_pop_exception (&e))
{
SLang_free_slstring (msg);/* NULL ok */
free_thrown_object ();
return -1;
}
break;
case 0: /* rethrow */
return rethrow_error ();
default:
_pSLang_verror (SL_NumArgs_Error, "expecting: throw error [, optional-message [, optional-arg]]");
return -1;
}
if (msg != NULL)
{
_pSLang_verror (e, "%s", msg);
SLang_free_slstring (msg);
}
else
SLang_set_error (e);
return 0;
}
static void intrin_putenv (void) /*{{{*/
{
char *s;
/* Some putenv implementations required malloced strings. */
if (SLpop_string(&s)) return;
if (putenv (s))
{
SLang_set_error (SL_OS_Error);
SLfree (s);
}
/* Note that s is NOT freed */
}
static int pop_writable_array (SLang_Array_Type **atp)
{
SLang_Array_Type *at;
if (-1 == SLang_pop_array (&at, 0))
return -1;
if (at->flags & SLARR_DATA_VALUE_IS_READ_ONLY)
{
SLang_set_error (SL_ReadOnly_Error);
SLang_free_array (at);
return -1;
}
*atp = at;
return 0;
}
int _pSLang_push_error_context (void)
{
Error_Context_Type *c;
if (NULL == (c = (Error_Context_Type *)SLmalloc (sizeof (Error_Context_Type))))
return -1;
c->next = Error_Context;
c->err = _pSLang_Error;
c->err_cleared = 0;
c->rethrow = 0;
c->file = File_With_Error;
c->function = Function_With_Error; /* steal pointers */
c->linenum = Linenum_With_Error;
c->err_queue = Error_Message_Queue;
File_With_Error = NULL;
Function_With_Error = NULL;
Linenum_With_Error = -1;
if (NULL == (Error_Message_Queue = _pSLerr_new_error_queue (1)))
{
Error_Message_Queue = c->err_queue;
SLfree ((char *) c);
return -1;
}
Error_Context = c;
SLKeyBoard_Quit = 0;
c->object_was_thrown = (Object_Thrownp != NULL);
if (c->object_was_thrown)
{
c->object_thrown = Object_Thrown;
Object_Thrownp = NULL;
}
if (-1 == SLang_set_error (0))
{
_pSLang_pop_error_context (1);
return -1;
}
return 0;
}
void _pSLerr_clear_error (int set_clear_err_flag)
{
SLang_set_error (0);
free_thrown_object ();
if ((Error_Context != NULL)
&& (set_clear_err_flag))
{
/* This is used only for error blocks */
Error_Context->err_cleared = 1;
}
SLang_free_slstring ((char *) File_With_Error); File_With_Error = NULL;
SLang_free_slstring ((char *) Function_With_Error); Function_With_Error = NULL;
Linenum_With_Error = -1;
Last_Function_With_Error = NULL;
if (SLang_User_Clear_Error != NULL) (*SLang_User_Clear_Error)();
_pSLerr_free_queued_messages ();
}
int SLclass_set_foreach_functions (SLang_Class_Type *cl,
SLang_Foreach_Context_Type *(*fe_open)(SLtype, unsigned int),
int (*fe)(SLtype, SLang_Foreach_Context_Type *),
void (*fe_close)(SLtype, SLang_Foreach_Context_Type *))
{
if (cl == NULL)
return -1;
if ((fe_open == NULL) || (fe == NULL) || (fe_close == NULL))
{
SLang_set_error (SL_APPLICATION_ERROR);
return -1;
}
cl->cl_foreach_open = fe_open;
cl->cl_foreach = fe;
cl->cl_foreach_close = fe_close;
return 0;
}
int SLerr_throw (int err, SLFUTURE_CONST char *msg, SLtype obj_type, VOID_STAR objptr)
{
free_thrown_object ();
if ((obj_type != 0) || (objptr != NULL))
{
if (-1 == SLang_push_value (obj_type, objptr))
return -1;
if (-1 == SLang_pop (&Object_Thrown))
return -1;
Object_Thrownp = &Object_Thrown;
}
if (msg != NULL)
_pSLang_verror (err, "%s", msg);
else
SLang_set_error (err);
return 0;
}
void exit_error(char *str, int severity)
{
static int already_here;
if (already_here)
return;
SLang_set_error (0);
SLKeyBoard_Quit = 0;
auto_save_all();
#if JED_HAS_EMACS_LOCKING
(void) jed_unlock_buffer_files ();
#endif
jed_reset_display();
reset_tty();
fprintf (stderr, "***Fatal Error: %s\n\n", str);
jed_show_version (stderr);
if (*Error_Buffer) fprintf (stderr, "%s\n", Error_Buffer);
if (CBuf != NULL)
{
if (Batch == 0)
{
fprintf(stderr, "CBuf: %p, CLine: %p, Point %d\n", (void *)CBuf, (void *) CLine, Point);
if (CLine != NULL) fprintf(stderr, "CLine: data: %p, len = %d, next: %p, prev %p\n",
(void *) CLine->data, CLine->len, (void *)CLine->next, (void *)CLine->prev);
fprintf(stderr, "Max_LineNum: %u, LineNum: %u\n", Max_LineNum, LineNum);
if (JWindow != NULL) fprintf(stderr, "JWindow: %p, top: %d, rows: %d, buffer: %p\n",
(void *)JWindow, JWindow->sy, JWindow->rows, (void *)JWindow->buffer);
}
}
if (severity)
{
#ifdef __unix__
fprintf(stderr, "Dumping Core.");
abort ();
#endif
}
exit (1);
}
static int complex_generic_binary (int op,
SLtype a_type, VOID_STAR ap, SLuindex_Type na,
SLtype b_type, VOID_STAR bp, SLuindex_Type nb,
VOID_STAR cp)
{
char *ic;
char *b;
double *a, *c;
SLuindex_Type n, n_max;
SLuindex_Type da, db;
unsigned int sizeof_b;
SLang_To_Double_Fun_Type to_double;
if (NULL == (to_double = SLarith_get_to_double_fun (b_type, &sizeof_b)))
return 0;
(void) a_type;
a = (double *) ap;
b = (char *) bp;
c = (double *) cp;
ic = (char *) cp;
if (na == 1) da = 0; else da = 2;
if (nb == 1) db = 0; else db = sizeof_b;
if (na > nb) n_max = na; else n_max = nb;
n_max = 2 * n_max;
switch (op)
{
default:
return 0;
case SLANG_POW:
for (n = 0; n < n_max; n += 2)
{
complex_dpow (c + n, a, to_double((VOID_STAR)b));
a += da; b += db;
}
break;
case SLANG_PLUS:
for (n = 0; n < n_max; n += 2)
{
c[n] = a[0] + to_double((VOID_STAR)b);
c[n + 1] = a[1];
a += da; b += db;
}
break;
case SLANG_MINUS:
for (n = 0; n < n_max; n += 2)
{
c[n] = a[0] - to_double((VOID_STAR)b);
c[n + 1] = a[1];
a += da; b += db;
}
break;
case SLANG_TIMES:
for (n = 0; n < n_max; n += 2)
{
double b0 = to_double((VOID_STAR)b);
c[n] = a[0] * b0;
c[n + 1] = a[1] * b0;
a += da; b += db;
}
break;
case SLANG_DIVIDE: /* / */
for (n = 0; n < n_max; n += 2)
{
double b0 = to_double((VOID_STAR)b);
#if 0
if (b0 == 0)
{
SLang_set_error (SL_DIVIDE_ERROR);
return -1;
}
#endif
c[n] = a[0] / b0;
c[n + 1] = a[1] / b0;
a += da; b += db;
}
break;
case SLANG_EQ: /* == */
for (n = 0; n < n_max; n += 2)
{
ic[n/2] = ((a[0] == to_double((VOID_STAR)b)) && (a[1] == 0.0));
a += da; b += db;
}
break;
case SLANG_NE: /* != */
for (n = 0; n < n_max; n += 2)
{
ic[n/2] = ((a[0] != to_double((VOID_STAR)b)) || (a[1] != 0.0));
a += da; b += db;
}
break;
}
return 1;
}
static int resize_table (SLang_Assoc_Array_Type *a)
{
int num_occupied, new_table_len;
_pSLAssoc_Array_Element_Type *old_es;
_pSLAssoc_Array_Element_Type *new_es;
num_occupied = a->num_occupied - a->num_deleted;
new_table_len = a->table_len;
if (num_occupied == 0)
num_occupied = (MIN_TABLE_SIZE >> 1);
new_table_len = a->table_len;
if (new_table_len < MIN_TABLE_SIZE)
new_table_len = MIN_TABLE_SIZE;
/* In practice, num_occupied*2 will not overflow because we would be
* out of memory if would be num_occupied objects stored.
*/
num_occupied *= 2;
while (num_occupied > new_table_len)
{
new_table_len *= 2;
if (new_table_len < 0)
{
SLang_set_error (SL_Malloc_Error);
return -1;
}
}
new_es = (_pSLAssoc_Array_Element_Type *)SLcalloc (new_table_len, sizeof (_pSLAssoc_Array_Element_Type));
if (new_es == NULL)
return -1;
if (NULL != (old_es = a->elements))
{
_pSLAssoc_Array_Element_Type *new_e, *old_e, *old_emax;
old_e = old_es;
old_emax = old_e + a->table_len;
while (old_e < old_emax)
{
SLCONST char *key = old_e->key;
if ((key == NULL) || (key == Deleted_Key))
{
old_e++;
continue;
}
/* Cannot fail */
new_e = find_empty_element (new_es, new_table_len, key, old_e->hash);
*new_e = *old_e;
old_e++;
}
SLfree ((char *)old_es);
}
a->elements = new_es;
a->table_len = new_table_len;
a->num_occupied -= a->num_deleted;
a->num_deleted = 0;
a->resize_num = 13*(new_table_len>>4);
return 0;
}
static int double_complex_binary (int op,
SLtype a_type, VOID_STAR ap, SLuindex_Type na,
SLtype b_type, VOID_STAR bp, SLuindex_Type nb,
VOID_STAR cp)
{
char *ic;
double *a, *b, *c;
SLuindex_Type n, n_max;
SLuindex_Type da, db;
(void) a_type;
(void) b_type;
a = (double *) ap;
b = (double *) bp;
c = (double *) cp;
ic = (char *) cp;
if (na == 1) da = 0; else da = 1;
if (nb == 1) db = 0; else db = 2;
if (na > nb) n_max = na; else n_max = nb;
n_max = 2 * n_max;
switch (op)
{
default:
return 0;
case SLANG_PLUS:
for (n = 0; n < n_max; n += 2)
{
c[n] = a[0] + b[0];
c[n + 1] = b[1];
a += da; b += db;
}
break;
case SLANG_MINUS:
for (n = 0; n < n_max; n += 2)
{
c[n] = a[0] - b[0];
c[n + 1] = -b[1];
a += da; b += db;
}
break;
case SLANG_TIMES:
for (n = 0; n < n_max; n += 2)
{
double a0 = a[0];
c[n] = a0 * b[0];
c[n + 1] = a0 * b[1];
a += da; b += db;
}
break;
case SLANG_DIVIDE: /* / */
for (n = 0; n < n_max; n += 2)
{
double z[2];
#if 0
if ((b[0] == 0.0) && (b[1] == 0.0))
{
SLang_set_error (SL_DIVIDE_ERROR);
return -1;
}
#endif
z[0] = a[0];
z[1] = 0.0;
SLcomplex_divide (c + n, z, b);
a += da; b += db;
}
break;
case SLANG_EQ: /* == */
for (n = 0; n < n_max; n += 2)
{
ic[n/2] = ((a[0] == b[0]) && (0.0 == b[1]));
a += da; b += db;
}
break;
case SLANG_NE: /* != */
for (n = 0; n < n_max; n += 2)
{
ic[n/2] = ((a[0] != b[0]) || (0.0 != b[1]));
a += da; b += db;
}
break;
case SLANG_POW:
for (n = 0; n < n_max; n += 2)
{
dcomplex_pow (c + n, a[0], b);
a += da; b += db;
}
break;
}
return 1;
}
static int process_key_event (KEY_EVENT_RECORD *key)
{
unsigned int key_state = 0;
unsigned int scan;
char c1;
DWORD d = key->dwControlKeyState;
unsigned char buf[4];
if (!key->bKeyDown) return 0;
if (d & (LEFT_ALT_PRESSED | RIGHT_ALT_PRESSED))
key_state |= _pSLTT_KEY_ALT;
if (d & (LEFT_CTRL_PRESSED | RIGHT_CTRL_PRESSED))
key_state |= _pSLTT_KEY_CTRL;
if (d & SHIFT_PRESSED)
key_state |= _pSLTT_KEY_SHIFT;
scan = key->wVirtualScanCode;
switch (scan)
{
case 0x00E: /* backspace */
return SLang_buffer_keystring ((unsigned char *)"\x7F", 1);
case 0x003: /* 2 key */
if (key_state & _pSLTT_KEY_ALT)
break;
/* Drop */
case 0x039: /* space */
if (key_state & _pSLTT_KEY_CTRL)
return SLang_buffer_keystring ((unsigned char *)"\x00\x03", 2);
break;
case 0x007: /* 6 key */
if (_pSLTT_KEY_CTRL == (key_state & (_pSLTT_KEY_ALT|_pSLTT_KEY_CTRL)))
return SLang_buffer_keystring ((unsigned char *)"\x1E", 1); /* Ctrl-^ */
break;
case 0x00C: /* -/_ key */
if (_pSLTT_KEY_CTRL == (key_state & (_pSLTT_KEY_ALT|_pSLTT_KEY_CTRL)))
return SLang_buffer_keystring ((unsigned char *)"\x1F", 1);
break;
case 0x00F: /* TAB */
if (_pSLTT_KEY_SHIFT == key_state)
return SLang_buffer_keystring ((unsigned char *)"\x00\x09", 2);
break;
case 0xE02F: /* KEYPAD SLASH */
case 0x037: /* KEYPAD STAR */
case 0x04A: /* KEYPAD MINUS */
case 0x04E: /* KEYPAD PLUS */
if (d & NUMLOCK_ON)
break;
case 0x047: /* KEYPAD HOME */
case 0x048: /* KEYPAD UP */
case 0x049: /* KEYPAD PGUP */
case 0x04B: /* KEYPAD LEFT */
case 0x04C: /* KEYPAD 5 */
case 0x04D: /* KEYPAD RIGHT */
case 0x04F: /* KEYPAD END */
case 0x050: /* KEYPAD DOWN */
case 0x051: /* KEYPAD PGDN */
case 0x052: /* KEYPAD INSERT */
case 0x053: /* KEYPAD DEL */
if (d & ENHANCED_KEY)
scan |= 0xE000;
else
{
if (d & NUMLOCK_ON)
break;
}
(void) _pSLpc_convert_scancode (scan, key_state, 0);
return 0;
case 0x3b: /* F1 */
case 0x3c:
case 0x3d:
case 0x3e:
case 0x3f:
case 0x40:
case 0x41:
case 0x42:
case 0x43:
case 0x44:
case 0x57:
case 0x58: /* F12 */
(void) _pSLpc_convert_scancode (scan, key_state, 0);
}
c1 = key->uChar.AsciiChar;
if (c1 != 0)
{
if (_pSLTT_KEY_ALT == (key_state & (_pSLTT_KEY_ALT|_pSLTT_KEY_CTRL)))
{
buf[0] = 27;
buf[1] = c1;
return SLang_buffer_keystring (buf, 2);
}
if (c1 == SLang_Abort_Char)
{
if (SLang_Ignore_User_Abort == 0)
SLang_set_error (USER_BREAK);
SLKeyBoard_Quit = 1;
}
buf[0] = c1;
return SLang_buffer_keystring (buf, 1);
}
return 0;
}
static int undefined_method (SLtype t, VOID_STAR p)
{
(void) t; (void) p;
SLang_set_error (SL_VARIABLE_UNINITIALIZED);
return -1;
}
/* 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 ();
}
static int generic_complex_binary (int op,
SLtype a_type, VOID_STAR ap, SLuindex_Type na,
SLtype b_type, VOID_STAR bp, SLuindex_Type nb,
VOID_STAR cp)
{
double *b, *c;
char *a, *ic;
SLuindex_Type n, n_max;
SLuindex_Type da, db;
unsigned int sizeof_a;
SLang_To_Double_Fun_Type to_double;
if (NULL == (to_double = SLarith_get_to_double_fun (a_type, &sizeof_a)))
return 0;
(void) b_type;
a = (char *) ap;
b = (double *) bp;
c = (double *) cp;
ic = (char *) cp;
if (na == 1) da = 0; else da = sizeof_a;
if (nb == 1) db = 0; else db = 2;
if (na > nb) n_max = na; else n_max = nb;
n_max = 2 * n_max;
switch (op)
{
default:
return 0;
case SLANG_POW:
for (n = 0; n < n_max; n += 2)
{
dcomplex_pow (c + n, to_double((VOID_STAR)a), b);
a += da; b += db;
}
break;
case SLANG_PLUS:
for (n = 0; n < n_max; n += 2)
{
c[n] = to_double((VOID_STAR)a) + b[0];
c[n + 1] = b[1];
a += da; b += db;
}
break;
case SLANG_MINUS:
for (n = 0; n < n_max; n += 2)
{
c[n] = to_double((VOID_STAR)a) - b[0];
c[n + 1] = -b[1];
a += da; b += db;
}
break;
case SLANG_TIMES:
for (n = 0; n < n_max; n += 2)
{
double a0 = to_double((VOID_STAR)a);
c[n] = a0 * b[0];
c[n + 1] = a0 * b[1];
a += da; b += db;
}
break;
case SLANG_DIVIDE: /* / */
for (n = 0; n < n_max; n += 2)
{
double z[2];
#if 0
if ((b[0] == 0.0) && (b[1] == 0.0))
{
SLang_set_error (SL_DIVIDE_ERROR);
return -1;
}
#endif
z[0] = to_double((VOID_STAR)a);
z[1] = 0.0;
SLcomplex_divide (c + n, z, b);
a += da; b += db;
}
break;
case SLANG_EQ: /* == */
for (n = 0; n < n_max; n += 2)
{
ic[n/2] = ((to_double((VOID_STAR)a) == b[0]) && (0.0 == b[1]));
a += da; b += db;
}
break;
case SLANG_NE: /* != */
for (n = 0; n < n_max; n += 2)
{
ic[n/2] = ((to_double((VOID_STAR)a) != b[0]) || (0.0 != b[1]));
a += da; b += db;
}
break;
}
return 1;
}
